diff --git a/.gitattributes b/.gitattributes index 096b1c29a1..3cabefadce 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,6 +1,4 @@ # add (semi-useful) version info to git archive CreateGitVersion.bat ident export-subst - # Declare files that will always have CRLF line endings on checkout. *.bat text eol=crlf - diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index 2a941bef2b..48085ccba8 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -25,7 +25,6 @@ - [ ] Create a merge commit in r-test and add a corresponding tag - [ ] Compile executables for Windows builds - [ ] FAST_SFunc.mexw64 - - [ ] MAP_X64.dll - [ ] OpenFAST-Simulink_x64.dll - [ ] openfast_x64.exe - [ ] DISCON.dll diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index a04fc80a2c..dd1a9de2f6 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -1,4 +1,4 @@ - + name: 'Development Pipeline' on: @@ -25,26 +25,31 @@ env: jobs: - regression-tests-aerodyn-driver: + ### BUILD JOBS + + + build-all-debug: + # Tests compiling in debug mode. + # Also compiles the Registry and generates new types files. + # Debug more speeds up the build. runs-on: ubuntu-20.04 steps: - name: Checkout uses: actions/checkout@main with: submodules: recursive - - name: Setup Python - uses: actions/setup-python@v2 + uses: actions/setup-python@v3 with: - python-version: '3.7' + python-version: '3.9' + cache: 'pip' - name: Install dependencies run: | python -m pip install --upgrade pip - pip install numpy Bokeh==1.4 - - - name: Setup Workspace + pip install numpy "Bokeh>=2.4" + - name: Setup workspace run: cmake -E make_directory ${{runner.workspace}}/openfast/build - - name: Configure Build + - name: Configure build working-directory: ${{runner.workspace}}/openfast/build run: | cmake \ @@ -52,47 +57,76 @@ jobs: -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ -DCMAKE_CXX_COMPILER:STRING=${{env.CXX_COMPILER}} \ -DCMAKE_C_COMPILER:STRING=${{env.C_COMPILER}} \ - -DCMAKE_BUILD_TYPE:STRING=RelWithDebInfo \ + -DCMAKE_BUILD_TYPE:STRING=DEBUG \ + -DBUILD_SHARED_LIBS:BOOL=OFF \ + -DGENERATE_TYPES=ON \ + -DVARIABLE_TRACKING=OFF \ -DBUILD_TESTING:BOOL=ON \ -DCTEST_PLOT_ERRORS:BOOL=ON \ ${GITHUB_WORKSPACE} - - name: Build AeroDyn Driver + # -DDOUBLE_PRECISION=OFF \ + - name: Build all working-directory: ${{runner.workspace}}/openfast/build - run: cmake --build . --target aerodyn_driver -- -j ${{env.NUM_PROCS}} - - - name: Run AeroDyn tests - uses: ./.github/actions/tests-module-aerodyn + run: | + cmake --build . --target all -- -j ${{env.NUM_PROCS}} + - name: Cache the workspace + uses: actions/cache@v3.0.4 with: - test-target: regression + path: ${{runner.workspace}} + key: build-all-debug-${{ github.sha }} - - name: Failing test artifacts - uses: actions/upload-artifact@v2 - if: failure() + build-all-debug-single: + # Tests compiling in debug mode with single precision. + # This workspace is not used by any other subtests, it checks type errors of the type ReKi/R8Ki + # Debug speeds up the build. + runs-on: ubuntu-20.04 + steps: + - name: Checkout + uses: actions/checkout@main with: - name: regression-tests-aerodyn-module - path: | - ${{runner.workspace}}/openfast/build/reg_tests/modules + submodules: recursive + - name: Setup workspace + run: cmake -E make_directory ${{runner.workspace}}/openfast/build + - name: Configure build + working-directory: ${{runner.workspace}}/openfast/build + run: | + cmake \ + -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/openfast/install \ + -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ + -DCMAKE_CXX_COMPILER:STRING=${{env.CXX_COMPILER}} \ + -DCMAKE_C_COMPILER:STRING=${{env.C_COMPILER}} \ + -DCMAKE_BUILD_TYPE:STRING=DEBUG \ + -DBUILD_SHARED_LIBS:BOOL=OFF \ + -DVARIABLE_TRACKING=OFF \ + -DDOUBLE_PRECISION:BOOL=OFF \ + ${GITHUB_WORKSPACE} + # -DDOUBLE_PRECISION=OFF \ + - name: Build all + working-directory: ${{runner.workspace}}/openfast/build + run: | + cmake --build . --target all -- -j ${{env.NUM_PROCS}} + - regression-tests-release: + + build-drivers-release: runs-on: ubuntu-20.04 steps: - name: Checkout uses: actions/checkout@main with: submodules: recursive - - name: Setup Python - uses: actions/setup-python@v2 + uses: actions/setup-python@v3 with: - python-version: '3.7' + python-version: '3.9' + cache: 'pip' - name: Install dependencies run: | python -m pip install --upgrade pip - pip install numpy Bokeh==1.4 - - - name: Setup Workspace + pip install numpy "Bokeh>=2.4" + - name: Setup workspace run: cmake -E make_directory ${{runner.workspace}}/openfast/build - - name: Configure Build + - name: Configure build working-directory: ${{runner.workspace}}/openfast/build run: | cmake \ @@ -101,400 +135,650 @@ jobs: -DCMAKE_CXX_COMPILER:STRING=${{env.CXX_COMPILER}} \ -DCMAKE_C_COMPILER:STRING=${{env.C_COMPILER}} \ -DCMAKE_BUILD_TYPE:STRING=RelWithDebInfo \ + -DVARIABLE_TRACKING=OFF \ -DBUILD_TESTING:BOOL=ON \ -DCTEST_PLOT_ERRORS:BOOL=ON \ ${GITHUB_WORKSPACE} - - name: Build OpenFAST - # if: contains(github.event.head_commit.message, 'Action - Test All') || contains(github.event.pull_request.labels.*.name, 'Action - Test All') + - name: Build module drivers working-directory: ${{runner.workspace}}/openfast/build - run: cmake --build . --target install -- -j ${{env.NUM_PROCS}} - - # SubDyn has only regression tests - - name: Run SubDyn tests - uses: ./.github/actions/tests-module-subdyn - # - name: Run AeroDyn tests - # uses: ./.github/actions/tests-module-aerodyn - # with: - # test-target: regression - # HydroDyn has only regression tests - - name: Run HydroDyn tests - uses: ./.github/actions/tests-module-hydrodyn - - name: Run InflowWind tests - uses: ./.github/actions/tests-module-inflowwind - with: - test-target: regression - - name: Run BeamDyn tests - uses: ./.github/actions/tests-module-beamdyn + run: | + cmake --build . --target regression_test_module_drivers -- -j ${{env.NUM_PROCS}} + - name: Cache the workspace + uses: actions/cache@v3.0.4 with: - test-target: regression - - name: Run OpenFAST tests - # if: contains(github.event.head_commit.message, 'Action - Test All') || contains(github.event.pull_request.labels.*.name, 'Action - Test All') - uses: ./.github/actions/tests-gluecode-openfast + path: ${{runner.workspace}} + key: build-drivers-release-${{ github.sha }} - - name: Failing test artifacts - uses: actions/upload-artifact@v2 - if: failure() - with: - name: regression-tests-release - 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 - regression-tests-debug: - runs-on: ${{ matrix.os }} - strategy: - fail-fast: false - matrix: - include: - - os: macOS-11 - FORTRAN_COMPILER: gfortran-11 - install_deps: brew install gcovr - - os: ubuntu-20.04 - FORTRAN_COMPILER: gfortran-10 - install_deps: sudo apt-get update && sudo apt-get install -y gcovr - - name: regression-test-debug-${{ matrix.os }}-${{ matrix.FORTRAN_COMPILER }} + build-postlib-release: + runs-on: ubuntu-20.04 steps: - name: Checkout uses: actions/checkout@main with: submodules: recursive - - name: Setup Python - uses: actions/setup-python@v2 + uses: actions/setup-python@v3 with: - python-version: '3.7' - - name: Install Dependencies + python-version: '3.9' + cache: 'pip' + - name: Install dependencies run: | python -m pip install --upgrade pip - pip install numpy Bokeh==1.4 - ${{matrix.install_deps}} - - - name: Setup Workspace + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev # gcovr + - name: Setup workspace run: cmake -E make_directory ${{runner.workspace}}/openfast/build - - name: Configure Build + - name: Configure build working-directory: ${{runner.workspace}}/openfast/build run: | cmake \ -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/openfast/install \ - -DCMAKE_Fortran_COMPILER:STRING=${{matrix.FORTRAN_COMPILER}} \ + -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ -DCMAKE_CXX_COMPILER:STRING=${{env.CXX_COMPILER}} \ -DCMAKE_C_COMPILER:STRING=${{env.C_COMPILER}} \ - -DCMAKE_BUILD_TYPE:STRING=Debug \ + -DCMAKE_BUILD_TYPE:STRING=RELWITHDEBINFO \ + -DOPENMP:BOOL=ON \ + -DDOUBLE_PRECISION=ON \ + -DVARIABLE_TRACKING=OFF \ + -DBUILD_FASTFARM:BOOL=ON \ + -DBUILD_OPENFAST_CPP_API:BOOL=ON \ + -DBUILD_SHARED_LIBS:BOOL=OFF \ -DBUILD_TESTING:BOOL=ON \ -DCTEST_PLOT_ERRORS:BOOL=ON \ ${GITHUB_WORKSPACE} + - name: Build openfast-postlib + working-directory: ${{runner.workspace}}/openfast/build + run: cmake --build . --target openfast_postlib -- -j ${{env.NUM_PROCS}} + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-postlib-release-${{ github.sha }} - - name: Build Drivers + + build-interfaces-release: + runs-on: ubuntu-20.04 + needs: build-postlib-release + steps: + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-postlib-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v3 + with: + python-version: '3.9' + cache: 'pip' + - name: Install dependencies + run: | + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Build OpenFAST C-Interfaces working-directory: ${{runner.workspace}}/openfast/build run: | - cmake --build . --target aerodyn_driver -- -j ${{env.NUM_PROCS}} - cmake --build . --target beamdyn_driver -- -j ${{env.NUM_PROCS}} - cmake --build . --target hydrodyn_driver -- -j ${{env.NUM_PROCS}} - cmake --build . --target inflowwind_driver -- -j ${{env.NUM_PROCS}} - cmake --build . --target subdyn_driver -- -j ${{env.NUM_PROCS}} + cmake --build . --target openfastlib -- -j ${{env.NUM_PROCS}} + cmake --build . --target openfast_cpp -- -j ${{env.NUM_PROCS}} + cmake --build . --target openfastcpp -- -j ${{env.NUM_PROCS}} + cmake --build . --target ifw_c_binding -- -j ${{env.NUM_PROCS}} + cmake --build . --target hydrodyn_c_binding -- -j ${{env.NUM_PROCS}} + cmake --build . --target regression_test_controllers -- -j ${{env.NUM_PROCS}} + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-interfaces-release-${{ github.sha }} - - name: Run SubDyn tests - uses: ./.github/actions/tests-module-subdyn - # - name: Run AeroDyn tests - # uses: ./.github/actions/tests-module-aerodyn - # with: - # test-target: regression - - name: Run HydroDyn tests - uses: ./.github/actions/tests-module-hydrodyn - - name: Run InflowWind tests - uses: ./.github/actions/tests-module-inflowwind + + build-openfast-release: + runs-on: ubuntu-20.04 + needs: build-postlib-release + steps: + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-postlib-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v3 + with: + python-version: '3.9' + cache: 'pip' + - name: Install dependencies + run: | + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Build OpenFAST glue-code + working-directory: ${{runner.workspace}}/openfast/build + run: | + cmake --build . --target openfast -- -j ${{env.NUM_PROCS}} + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-openfast-release-${{ github.sha }} + + + build-fastfarm-release: + runs-on: ubuntu-20.04 + needs: build-postlib-release + steps: + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-postlib-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v3 + with: + python-version: '3.9' + cache: 'pip' + - name: Install dependencies + run: | + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Build FAST.Farm + working-directory: ${{runner.workspace}}/openfast/build + run: | + cmake --build . --target FAST.Farm -- -j ${{env.NUM_PROCS}} + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-fastfarm-release-${{ github.sha }} + + + ### TEST JOBS + + rtest-module-drivers: + runs-on: ubuntu-20.04 + needs: build-drivers-release + steps: + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-drivers-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v3 + with: + python-version: '3.9' + cache: 'pip' + - name: Install dependencies + run: | + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Run AeroDyn tests + uses: ./.github/actions/tests-module-aerodyn with: test-target: regression - name: Run BeamDyn tests uses: ./.github/actions/tests-module-beamdyn with: test-target: regression - - # Disabled Codecov since the dashboard and GitHub comments were buggy, - # but it may be useful to post the gcov coverage reports to GitHub Actions - # artifacts. - # Note: if reenabling Codecov, the reports must be in xml format not html. - # - name: Generate coverage report - # working-directory: ${{runner.workspace}}/openfast/build - # run: | - # find . -type f -name '*.gcno' -not -path "**tests**" -exec ${{env.GCOV_EXE}} -pb {} + - # cd .. - # gcovr -g -k -r . --html --html-details -o regressioncov.html # -v - # # cp `find . -name *.gcno` . - # # cp `find . -name *.gcda` . - # # ${{env.GCOV_EXE}} -b -l -p -c *.gcno - # - name: Success artifacts - # uses: actions/upload-artifact@v2 - # if: success() - # with: - # name: regression-tests-debug - # path: | - # ${{runner.workspace}}/openfast/regressioncov.html + - name: Run HydroDyn tests + uses: ./.github/actions/tests-module-hydrodyn + - name: Run InflowWind tests + uses: ./.github/actions/tests-module-inflowwind + with: + test-target: regression + - name: Run SubDyn tests + uses: ./.github/actions/tests-module-subdyn - name: Failing test artifacts - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v3 if: failure() with: - name: regression-tests-debug + name: rtest-module-drivers path: | ${{runner.workspace}}/openfast/build/reg_tests/modules - fastfarm-regression-test: + + rtest-modules-debug: runs-on: ubuntu-20.04 + needs: build-all-debug steps: - - name: Checkout - uses: actions/checkout@main + - name: Cache the workspace + uses: actions/cache@v3.0.4 with: - submodules: recursive - + path: ${{runner.workspace}} + key: build-all-debug-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v2 + uses: actions/setup-python@v3 with: - python-version: '3.7' + python-version: '3.9' + cache: 'pip' - name: Install dependencies run: | python -m pip install --upgrade pip - pip install numpy Bokeh==1.4 - - - name: Setup Workspace - run: cmake -E make_directory ${{runner.workspace}}/openfast/build - - name: Configure Build + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | cmake \ - -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/openfast/install \ - -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ - -DOPENMP:BOOL=ON \ - -DBUILD_FASTFARM:BOOL=ON \ - -DCMAKE_BUILD_TYPE:STRING=RelWithDebInfo \ -DBUILD_TESTING:BOOL=ON \ -DCTEST_PLOT_ERRORS:BOOL=ON \ ${GITHUB_WORKSPACE} - - name: Build FAST.Farm - # if: contains(github.event.head_commit.message, 'Action - Test All') || contains(github.event.pull_request.labels.*.name, 'Action - Test All') + cmake --build . --target regression_test_controllers -- -j ${{env.NUM_PROCS}} + - name: Run AeroDyn tests + uses: ./.github/actions/tests-module-aerodyn + with: + # Don't run regression tests here since they currently fail inconsistently + test-target: unit + - name: Run BeamDyn tests + uses: ./.github/actions/tests-module-beamdyn + - name: Run HydroDyn tests + uses: ./.github/actions/tests-module-hydrodyn + - name: Run InflowWind tests + uses: ./.github/actions/tests-module-inflowwind + - name: Run NWTC Library tests + uses: ./.github/actions/tests-module-nwtclibrary + - name: Run SubDyn tests + uses: ./.github/actions/tests-module-subdyn + - name: Run VersionInfo tests + uses: ./.github/actions/tests-module-version + - name: Failing test artifacts + uses: actions/upload-artifact@v3 + if: failure() + with: + name: rtest-modules-debug + path: | + ${{runner.workspace}}/openfast/build/reg_tests/modules + ${{runner.workspace}}/openfast/build/unit_tests + + + rtest-interfaces: + runs-on: ubuntu-20.04 + needs: build-interfaces-release + steps: + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-interfaces-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v3 + with: + python-version: '3.9' + cache: 'pip' + - name: Install dependencies + run: | + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Run Interface / API tests working-directory: ${{runner.workspace}}/openfast/build run: | - cmake --build . --target FAST.Farm -- -j ${{env.NUM_PROCS}} - cmake --build . --target regression_tests -- -j ${{env.NUM_PROCS}} + ctest -VV -L "cpp|python|fastlib" -j ${{env.NUM_PROCS}} + - name: Failing test artifacts + uses: actions/upload-artifact@v3 + if: failure() + with: + name: rtest-interfaces + path: | + ${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast-cpp + ${{runner.workspace}}/openfast/build/reg_tests/glue-codes/python + ${{runner.workspace}}/openfast/build/reg_tests/modules/inflowwind + ${{runner.workspace}}/openfast/build/reg_tests/modules/hydrodyn + !${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast-cpp/5MW_Baseline - - name: Run FAST.Farm tests + + rtest-OF: + runs-on: ubuntu-20.04 + needs: build-openfast-release + steps: + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-openfast-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v3 + with: + python-version: '3.9' + cache: 'pip' + - name: Install dependencies run: | - ctest -VV -L fastfarm -j ${{env.NUM_PROCS}} + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build - shell: bash - + run: | + cmake --build . --target regression_test_controllers -- -j ${{env.NUM_PROCS}} + - name: Run 5MW tests + working-directory: ${{runner.workspace}}/openfast/build + run: | + ctest -VV -j8 \ + -L openfast \ + -LE "cpp|linear|python|fastlib" \ + -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@v2 + uses: actions/upload-artifact@v3 if: failure() with: - name: test-results + name: rtest-OF path: | - ${{runner.workspace}}/openfast/build/reg_tests/glue-codes/fastfarm + ${{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 - unit-test: + + rtest-OF-5MW_OC4Semi_WSt_WavesWN: runs-on: ubuntu-20.04 + needs: build-openfast-release steps: - - name: Checkout - uses: actions/checkout@main + - name: Cache the workspace + uses: actions/cache@v3.0.4 with: - submodules: recursive - + path: ${{runner.workspace}} + key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v2 + uses: actions/setup-python@v3 with: - python-version: '3.7' + python-version: '3.9' + cache: 'pip' - name: Install dependencies run: | python -m pip install --upgrade pip - pip install numpy Bokeh==1.4 - + pip install numpy "Bokeh>=2.4" sudo apt-get update -y - sudo apt-get install -y gcovr - - - name: Setup Workspace - run: cmake -E make_directory ${{runner.workspace}}/openfast/build - - name: Configure Build + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | - cmake \ - -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/openfast/install \ - -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ - -DCMAKE_CXX_COMPILER:STRING=${{env.CXX_COMPILER}} \ - -DCMAKE_C_COMPILER:STRING=${{env.C_COMPILER}} \ - -DCMAKE_BUILD_TYPE:STRING=Debug \ - -DBUILD_TESTING:BOOL=ON \ - ${GITHUB_WORKSPACE} - - - name: Build unit tests + cmake --build . --target regression_test_controllers -- -j ${{env.NUM_PROCS}} + - name: Run 5MW tests working-directory: ${{runner.workspace}}/openfast/build - run: cmake --build . --target unit_tests -- -j ${{env.NUM_PROCS}} + run: | + ctest -VV -L openfast -LE "cpp|linear|python" -R 5MW_OC4Semi_WSt_WavesWN + - name: Failing test artifacts + uses: actions/upload-artifact@v3 + if: failure() + with: + name: rtest-OF-5MW_OC4Semi_WSt_WavesWN + 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 - # NWTC Library has only unit tests - - name: Run NWTC Library tests - uses: ./.github/actions/tests-module-nwtclibrary - # VersionInfo has only unit tests - - name: Run VersionInfo tests - uses: ./.github/actions/tests-module-version - - name: Run AeroDyn tests - uses: ./.github/actions/tests-module-aerodyn + + rtest-OF-5MW_OC3Mnpl_DLL_WTurb_WavesIrr: + runs-on: ubuntu-20.04 + needs: build-openfast-release + steps: + - name: Cache the workspace + uses: actions/cache@v3.0.4 with: - test-target: unit - - name: Run BeamDyn tests - uses: ./.github/actions/tests-module-beamdyn + path: ${{runner.workspace}} + key: build-openfast-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v3 with: - test-target: unit - - name: Run InflowWind tests - uses: ./.github/actions/tests-module-inflowwind + python-version: '3.9' + cache: 'pip' + - name: Install dependencies + run: | + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Configure Tests + working-directory: ${{runner.workspace}}/openfast/build + run: | + cmake --build . --target regression_test_controllers -- -j ${{env.NUM_PROCS}} + - 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 + - name: Failing test artifacts + uses: actions/upload-artifact@v3 + if: failure() with: - test-target: unit + name: rtest-OF-5MW_OC3Mnpl_DLL_WTurb_WavesIrr + 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 - # Disabled Codecov since the dashboard and GitHub comments were buggy, - # but it may be useful to post the gcov coverage reports to GitHub Actions - # artifacts. - # Note: if reenabling Codecov, the reports must be in xml format not html. - # - name: Generate coverage report - # working-directory: ${{runner.workspace}}/openfast/build - # run: | - # find . -type f -name '*.gcno' -not -path "**tests**" -exec ${{env.GCOV_EXE}} -pb {} + - # cd .. - # gcovr -g -k -r . --html --html-details unitcov.html - # - name: Success artifacts - # uses: actions/upload-artifact@v2 - # if: success() - # with: - # name: unit-tests - # path: | - # ${{runner.workspace}}/openfast/unitcov.html + rtest-OF-5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth: + runs-on: ubuntu-20.04 + needs: build-openfast-release + steps: + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-openfast-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v3 + with: + python-version: '3.9' + cache: 'pip' + - name: Install dependencies + run: | + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Configure Tests + working-directory: ${{runner.workspace}}/openfast/build + run: | + cmake --build . --target regression_test_controllers -- -j ${{env.NUM_PROCS}} + - name: Run 5MW tests + working-directory: ${{runner.workspace}}/openfast/build + run: | + ctest -VV -L openfast -LE "cpp|linear|python" -R 5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth - name: Failing test artifacts - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v3 if: failure() with: - name: unit-tests + name: rtest-OF-5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth path: | - ${{runner.workspace}}/openfast/build/unit_tests + ${{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 - compile-all-single-precision: - # Test if single precision compile completes. - # Compiles all targets excluding tests. - # Run with the OpenFAST registry generating the types files. - # Do not run the test suite. + rtest-OF-5MW_OC3Trpd_DLL_WSt_WavesReg: runs-on: ubuntu-20.04 + needs: build-openfast-release steps: - - name: Checkout - uses: actions/checkout@main + - name: Cache the workspace + uses: actions/cache@v3.0.4 with: - submodules: recursive - - name: Setup - run: cmake -E make_directory ${{runner.workspace}}/openfast/build - - name: Configure - working-directory: ${{runner.workspace}}/openfast/build + path: ${{runner.workspace}} + key: build-openfast-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v3 + with: + python-version: '3.9' + cache: 'pip' + - name: Install dependencies run: | - cmake \ - -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/openfast/install \ - -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ - -DCMAKE_BUILD_TYPE:STRING=Debug \ - -DDOUBLE_PRECISION:BOOL=OFF \ - -DGENERATE_TYPES:BOOL=ON \ - ${GITHUB_WORKSPACE} - - name: Build all + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build - run: cmake --build . --target all -- -j ${{env.NUM_PROCS}} - - name: Test + run: | + cmake --build . --target regression_test_controllers -- -j ${{env.NUM_PROCS}} + - name: Run 5MW tests working-directory: ${{runner.workspace}}/openfast/build - run: ./glue-codes/openfast/openfast -v + run: | + ctest -VV -L openfast -LE "cpp|linear|python" -R 5MW_OC3Trpd_DLL_WSt_WavesReg + - name: Failing test artifacts + uses: actions/upload-artifact@v3 + if: failure() + with: + name: rtest-OF-5MW_OC3Trpd_DLL_WSt_WavesReg + 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 + - interface-tests: + rtest-OF-5MW_Land_BD_DLL_WTurb: runs-on: ubuntu-20.04 + needs: build-openfast-release steps: - - name: Checkout - uses: actions/checkout@main + - name: Cache the workspace + uses: actions/cache@v3.0.4 with: - submodules: recursive - + path: ${{runner.workspace}} + key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v2 + uses: actions/setup-python@v3 with: - python-version: '3.7' + python-version: '3.9' + cache: 'pip' - name: Install dependencies run: | python -m pip install --upgrade pip - pip install numpy Bokeh==1.4 - + pip install numpy "Bokeh>=2.4" sudo apt-get update -y - sudo apt-get install -y gcovr sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev - - - name: Setup Workspace - run: cmake -E make_directory ${{runner.workspace}}/openfast/build - - name: Configure Build + - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | - cmake \ - -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/openfast/install \ - -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ - -DCMAKE_CXX_COMPILER:STRING=${{env.CXX_COMPILER}} \ - -DCMAKE_C_COMPILER:STRING=${{env.C_COMPILER}} \ - -DCMAKE_BUILD_TYPE:STRING=RelWithDebInfo \ - -DBUILD_OPENFAST_CPP_API:BOOL=ON \ - -DBUILD_SHARED_LIBS:BOOL=ON \ - -DBUILD_TESTING:BOOL=ON \ - -DCTEST_PLOT_ERRORS:BOOL=ON \ - ${GITHUB_WORKSPACE} - - - name: Build OpenFAST C-Interfaces + cmake --build . --target regression_test_controllers -- -j ${{env.NUM_PROCS}} + - name: Run 5MW tests working-directory: ${{runner.workspace}}/openfast/build run: | - cmake --build . --target openfastlib -- -j ${{env.NUM_PROCS}} - cmake --build . --target openfast_cpp -- -j ${{env.NUM_PROCS}} - cmake --build . --target openfastcpp -- -j ${{env.NUM_PROCS}} - cmake --build . --target hydrodyn_c_binding -- -j ${{env.NUM_PROCS}} - cmake --build . --target ifw_c_binding -- -j ${{env.NUM_PROCS}} - cmake --build . --target regression_tests -- -j ${{env.NUM_PROCS}} + ctest -VV -L openfast -LE "cpp|linear|python" -R 5MW_Land_BD_DLL_WTurb + - name: Failing test artifacts + uses: actions/upload-artifact@v3 + if: failure() + with: + name: rtest-OF-5MW_Land_BD_DLL_WTurb + 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 - - name: Run C++ API tests + + rtest-OF-linearization: + runs-on: ubuntu-20.04 + needs: build-openfast-release + steps: + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-openfast-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v3 + with: + python-version: '3.9' + cache: 'pip' + - name: Install dependencies + run: | + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | - ctest -VV -L cpp - - - name: Run Python API tests + cmake --build . --target regression_test_controllers -- -j ${{env.NUM_PROCS}} + - name: Run OpenFAST linearization tests working-directory: ${{runner.workspace}}/openfast/build run: | - ctest -VV -L python - - # Disabled Codecov since the dashboard and GitHub comments were buggy, - # but it may be useful to post the gcov coverage reports to GitHub Actions - # artifacts. - # Note: if reenabling Codecov, the reports must be in xml format not html. - # - name: Generate coverage report - # working-directory: ${{runner.workspace}}/openfast/build - # run: | - # find . -type f -name '*.gcno' -not -path "**tests**" -exec ${{env.GCOV_EXE}} -pb {} + - # cd .. - # gcovr -g -k -r . --html --html-details regressioncov.html - # - name: Success artifacts - # uses: actions/upload-artifact@v2 - # if: success() - # with: - # name: c-interface-reg-tests - # path: | - # ${{runner.workspace}}/openfast/regressioncov.html + ctest -VV -j8 -L linear + - name: Failing test artifacts + uses: actions/upload-artifact@v3 + if: failure() + with: + name: rtest-OF-linearization + 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-FF: + runs-on: ubuntu-20.04 + needs: build-fastfarm-release + steps: + - name: Cache the workspace + uses: actions/cache@v3.0.4 + with: + path: ${{runner.workspace}} + key: build-fastfarm-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v3 + with: + python-version: '3.9' + cache: 'pip' + - name: Install dependencies + run: | + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4" + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Configure Tests + working-directory: ${{runner.workspace}}/openfast/build + run: | + cmake --build . --target regression_test_controllers -- -j ${{env.NUM_PROCS}} + - name: Run FAST.Farm tests + working-directory: ${{runner.workspace}}/openfast/build + shell: bash + run: | + ctest -VV -L fastfarm -j ${{env.NUM_PROCS}} - name: Failing test artifacts - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v3 if: failure() with: - name: interface-reg-tests + name: rtest-FF path: | - ${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast-cpp - ${{runner.workspace}}/openfast/build/reg_tests/glue-codes/python - ${{runner.workspace}}/openfast/build/reg_tests/modules/hydrodyn - ${{runner.workspace}}/openfast/build/reg_tests/modules/inflowwind - !${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast-cpp/5MW_Baseline + ${{runner.workspace}}/openfast/build/reg_tests/glue-codes/fastfarm diff --git a/CMakeLists.txt b/CMakeLists.txt index 36f0a0ecc3..9d1d3dd61a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -28,6 +28,7 @@ if (NOT CMAKE_BUILD_TYPE) "Choose the build type: Debug Release" FORCE) endif (NOT CMAKE_BUILD_TYPE) +option(VARIABLE_TRACKING "Enables variable tracking for better runtime debugging output. May increase compile time. Valid only for GNU." on) option(GENERATE_TYPES "Use the openfast-regsitry to autogenerate types modules" off) option(BUILD_SHARED_LIBS "Enable building shared libraries" off) option(DOUBLE_PRECISION "Treat REAL as double precision" on) @@ -45,6 +46,12 @@ if(APPLE) option(CMAKE_MACOSX_RPATH "Use RPATH runtime linking" on) endif() +# Warn if atypical configuration for variable tracking and build type +string(TOUPPER ${CMAKE_BUILD_TYPE} _build_type) +if(NOT ${VARIABLE_TRACKING} AND (${_build_type} STREQUAL "DEBUG" OR ${_build_type} STREQUAL "RELWITHDEBINFO") ) + message(WARNING "Variable tracking is disabled and build type includes debug symbols. This may reduce the ability to debug.") +endif() + # Precompiler/preprocessor flag configuration # Do this before configuring modules so that the flags are included option(BUILD_TESTING "Build the testing tree." OFF) diff --git a/cmake/OpenfastFortranOptions.cmake b/cmake/OpenfastFortranOptions.cmake index b936aed4bf..ad7d4ffc78 100644 --- a/cmake/OpenfastFortranOptions.cmake +++ b/cmake/OpenfastFortranOptions.cmake @@ -101,6 +101,7 @@ 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") endif(NOT WIN32) # Fix free-form compilation for OpenFAST diff --git a/docs/conf.py b/docs/conf.py index 7bd700a916..baa3e397b0 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -120,7 +120,7 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): # General information about the project. project = u'OpenFAST' -copyright = u'2021, National Renewable Energy Laboratory' +copyright = u'2022, National Renewable Energy Laboratory' author = u'OpenFAST Team' # The version info for the project you're documenting, acts as replacement for @@ -128,9 +128,9 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): # built documents. # # The short X.Y version. -version = u'3.2' +version = u'3.3' # The full version, including alpha/beta/rc tags. -release = u'v3.2.0' +release = u'v3.3.0' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/docs/source/dev/code_style.rst b/docs/source/dev/code_style.rst index eac515713b..9e383738b9 100644 --- a/docs/source/dev/code_style.rst +++ b/docs/source/dev/code_style.rst @@ -4,7 +4,7 @@ Code Style ~~~~~~~~~~ OpenFAST and its underlying modules are mostly written in Fortran adhering to the 2003 standard, but modules can be written in C or C++. The -`NWTC Programmer's Handbook `__ +:download:`NWTC Programmer's Handbook <../../OtherSupporting/NWTC_Programmers_Handbook.pdf>` is the definitive reference for all questions related to working with the FAST Framework and adding code to OpenFAST. diff --git a/docs/source/testing/index.rst b/docs/source/testing/index.rst index a8dad20a20..77fea3c218 100644 --- a/docs/source/testing/index.rst +++ b/docs/source/testing/index.rst @@ -29,8 +29,6 @@ GitHub users and is highly recommended as part of the development workflow. After enabling GitHub Actions in an OpenFAST repository, simply pushing new commits will trigger the tests. -Test specific documentation ---------------------------- .. toctree:: :maxdepth: 1 diff --git a/docs/source/testing/regression_test.rst b/docs/source/testing/regression_test.rst index 212e7dd4ca..bb134c501f 100644 --- a/docs/source/testing/regression_test.rst +++ b/docs/source/testing/regression_test.rst @@ -1,7 +1,7 @@ .. _regression_test: -Regression test -=============== +Regression tests +================ The regression test executes a series of test cases which intend to fully describe OpenFAST and its module's capabilities. Jump to one of the following sections for instructions on running the regression diff --git a/docs/source/testing/unit_test.rst b/docs/source/testing/unit_test.rst index e8bfd3f9e7..31c9cca58c 100644 --- a/docs/source/testing/unit_test.rst +++ b/docs/source/testing/unit_test.rst @@ -1,7 +1,7 @@ .. _unit_test: -Unit test -========= +Unit tests +========== In a software package as dynamic and collaborative as OpenFAST, confidence in multiple layers of code is best accomplished with a strong system of unit tests. Through robust testing practices, the entire OpenFAST community can diff --git a/docs/source/this_doc.rst b/docs/source/this_doc.rst index 78b3ffa5df..2991b53fa4 100644 --- a/docs/source/this_doc.rst +++ b/docs/source/this_doc.rst @@ -19,7 +19,7 @@ and link to other relevant websites. While OpenFAST developer documentation is being enhanced here, developers are encouraged to consult the legacy FAST v8 -`Programmer's Handbook `_. +:download:`NWTC Programmer's Handbook <../OtherSupporting/NWTC_Programmers_Handbook.pdf>`. Instructions on obtaining and installing OpenFAST are available in :ref:`installation`, and documentation for verifying an installation with the automated tests is at :ref:`testing`. diff --git a/docs/source/user/aerodyn/appendix.rst b/docs/source/user/aerodyn/appendix.rst index 0a92e1bb0a..97b8f43758 100644 --- a/docs/source/user/aerodyn/appendix.rst +++ b/docs/source/user/aerodyn/appendix.rst @@ -57,10 +57,10 @@ The local tower coordinate system is shown in :numref:`ad_tower_geom` and the lo .. _ad_blade_local_cs: -.. figure:: figs/ad_blade_local_cs.png +.. figure:: figs/aerodyn_blade_local_cs.png :width: 80% :align: center - :alt: ad_blade_local_cs.png + :alt: aerodyn_blade_local_cs.png AeroDyn Local Blade Coordinate System (Looking Toward the Tip, from the Root) – l: Lift, d: Drag, m: Pitching, x: Normal (to Plane), @@ -69,9 +69,9 @@ The local tower coordinate system is shown in :numref:`ad_tower_geom` and the lo .. _ad-output-channel: -.. figure:: figs/ad_output_channel.pdf +.. figure:: figs/aerodyn_output_channel.pdf :width: 500px :align: center - :alt: ad_output_channel.pdf + :alt: aerodyn_output_channel.pdf AeroDyn Output Channel List diff --git a/docs/source/user/aerodyn/bibliography.bib b/docs/source/user/aerodyn/bibliography.bib index 248a77a523..cd9265b2dc 100644 --- a/docs/source/user/aerodyn/bibliography.bib +++ b/docs/source/user/aerodyn/bibliography.bib @@ -26,6 +26,18 @@ @book{ad-Branlard:book } +@article{ad-Branlard:2022, + author = {E Branlard and B Jonkman and G R Pirrung and K Dixon and J Jonkman}, + title = {Dynamic inflow and unsteady aerodynamics models for modal and stability analyses in {OpenFAST}}, + doi = {10.1088/1742-6596/2265/3/032044}, + year = 2022, + publisher = {{IOP} Publishing}, + volume = {2265}, + number = {3}, + pages = {032044}, + journal = {Journal of Physics: Conference Series} +} + @article{ad-Hansen:book, author = {Hansen, M. O. L. and S{\o}rensen, J. N. and Voutsinas, S. and S{\o}rensen, N. and Madsen, H. Aa.}, doi = {10.1016/j.paerosci.2006.10.002}, diff --git a/docs/source/user/aerodyn/driver.rst b/docs/source/user/aerodyn/driver.rst index 0c214249e8..4d8748ce5b 100644 --- a/docs/source/user/aerodyn/driver.rst +++ b/docs/source/user/aerodyn/driver.rst @@ -152,7 +152,7 @@ Two turbine input formats are supported: In this format, the turbine geometry is entirely determined by the number of blades (`NumBlades`), the hub radius (`HubRad`), the hub height (`HubHt`), the overhang (`Overhang`), the shaft tilt (`ShftTilt`), the precone (`Precone`), and the vertical distance from the tower-top to the rotor shaft (`Twr2Shft`), as shown in :numref:`fig:BasicGeometry`. The definition of each parameter follows the ElastoDyn convention. For example, `HubRad` specifies the radius from the center-of-rotation to the blade root along the (possibly preconed) blade-pitch axis and must be greater than zero. `HubHt` specifies the elevation of the hub center above the ground for land-based wind turbines, above the mean sea level (MSL) for offshore wind turbines, or above the seabed for MHK turbines. `Overhang` specifies the distance along the (possibly tilted) rotor shaft between the tower centerline and hub center and is positive downwind (use a negative number for upwind rotors). `ShftTilt` is the angle (in degrees) between the rotor shaft and the horizontal plane, and positive `ShftTilt` means that the downwind end of the shaft is the highest (upwind turbines have negative `ShftTilt` for improved tower clearance). `Precone` is the angle (in degrees) between a flat rotor disk and the cone swept by the blades, positive downwind (upwind turbines have negative `Precone` for improved tower clearance). - .. figure:: figs/ad_driver_geom.png + .. figure:: figs/aerodyn_driver_geom.png :width: 60% :name: fig:BasicGeometry diff --git a/docs/source/user/aerodyn/examples/ad_driver_example.dvr b/docs/source/user/aerodyn/examples/ad_driver_example.dvr index d390e38561..ea92c3edd1 100644 --- a/docs/source/user/aerodyn/examples/ad_driver_example.dvr +++ b/docs/source/user/aerodyn/examples/ad_driver_example.dvr @@ -34,9 +34,9 @@ False Echo - Echo input parameters to ".ech"? 3.09343 Twr2Shft(1) - Vertical distance from the tower-top to the rotor shaft (m) ----- Turbine(1) Motion [used only when AnalysisType=1] --------------------------------- 1 BaseMotionType(1) - Type of motion prescribed for this base {0: fixed, 1: Sinusoidal motion, 2: arbitrary motion} (flag) -1 DegreeOfFreedom(1) - {1:xg, 2:yg, 3:zg, 4:theta_xg, 5:theta_yg, 6:theta_zg} [used only when BaseMotionType=1] (flag) -5.0 Amplitude(1) - Amplitude of sinusoidal motion [used only when BaseMotionType=1] -0.1 Frequency(1) - Frequency of sinusoidal motion [used only when BaseMotionType=1] +1 DegreeOfFreedom(1) - {1:xt, 2:yt, 3:zt, 4:theta_xt, 5:theta_yt, 6:theta_zt} [used only when BaseMotionType=1] (flag) +5.0 Amplitude(1) - Amplitude of sinusoidal motion [used only when BaseMotionType=1] (m or rad) +0.1 Frequency(1) - Frequency of sinusoidal motion [used only when BaseMotionType=1] (Hz) "" BaseMotionFileName(1) - Filename containing arbitrary base motion (19 columns: Time, x, y, z, theta_x, ..., alpha_z) [used only when BaseMotionType=2] 0 NacYaw(1) - Yaw angle (about z_t) of the nacelle (deg) 7 RotSpeed(1) - Rotational speed of rotor in rotor coordinates (rpm) @@ -54,6 +54,7 @@ HWndSpeed PLExp RotSpd Pitch Yaw dT Tmax DOF Amplitude Frequency ----- Output Settings ------------------------------------------------------------------- "ES15.8E2" OutFmt - Format used for text tabular output, excluding the time channel. Resulting field should be 10 characters. (quoted string) 2 OutFileFmt - Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 3: both} -0 WrVTK - VTK visualization data output: (switch) {0=none; 1=animation} +0 WrVTK - VTK visualization data output: (switch) {0=none; 1=init; 2=animation} +1 WrVTK_Type - VTK visualization data type: (switch) {1=surfaces; 2=lines; 3=both} 2 VTKHubRad - HubRadius for VTK visualization (m) -1,-1,-1,2,2,2 VTKNacDim - Nacelle Dimension for VTK visualization x0,y0,z0,Lx,Ly,Lz (m) diff --git a/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr b/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr index 43e601ae87..00cf198871 100644 --- a/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr +++ b/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr @@ -46,8 +46,8 @@ True HAWTprojection(1) - True if turbine is a horizontal axis tu ----- Turbine(1) Motion [used only when AnalysisType=1] --------------------------------- 0 BaseMotionType(1) - Type of motion prescribed for this base {0: fixed, 1: Sinusoidal motion, 2: arbitrary motion} (flag) 1 DegreeOfFreedom(1) - {1:xt, 2:yt, 3:zt, 4:theta_xt, 5:theta_yt, 6:theta_zt} [used only when BaseMotionType=1] (flag) -0 Amplitude(1) - Amplitude of sinusoidal motion [used only when BaseMotionType=1] -0 Frequency(1) - Frequency of sinusoidal motion [used only when BaseMotionType=1] +0 Amplitude(1) - Amplitude of sinusoidal motion [used only when BaseMotionType=1] (m or rad) +0 Frequency(1) - Frequency of sinusoidal motion [used only when BaseMotionType=1] (Hz) "unused" BaseMotionFileName(1) - Filename containing arbitrary base motion (19 columns: Time, x, y, z, theta_x, ..., alpha_z) [used only when BaseMotionType=2] 0 NacMotionType(1) - Type of motion prescribed for the nacelle {0: fixed yaw, 1: time varying yaw angle} (flag) 0 NacYaw(1) - Yaw angle (about z_t) of the nacelle [user only when NacMotionType=0] (deg) @@ -75,8 +75,8 @@ True HAWTprojection(1) - True if turbine is a horizontal axis tu ----- Turbine(2) Motion [used only when AnalysisType=1] --------------------------------- 0 BaseMotionType(2) - Type of motion prescribed for this base {0: fixed, 1: Sinusoidal motion, 2: arbitrary motion} (flag) 0 DegreeOfFreedom(2) - {1:xt, 2:yt, 3:zt, 4:theta_xt, 5:theta_yt, 6:theta_zt} [used only when BaseMotionType=1] (flag) -0.0 Amplitude(2) - Amplitude of sinusoidal motion [used only when BaseMotionType=1] -0.0 Frequency(2) - Frequency of sinusoidal motion [used only when BaseMotionType=1] +0.0 Amplitude(2) - Amplitude of sinusoidal motion [used only when BaseMotionType=1] (m or deg) +0.0 Frequency(2) - Frequency of sinusoidal motion [used only when BaseMotionType=1] (Hz) "unused" BaseMotionFileName(2) - Filename containing arbitrary base motion (29 columns: Time, x, y, z, theta_x, ..., alpha_z) [used only when BaseMotionType=2] 0 NacYaw(2) - Yaw angle (about z_t) of the nacelle [user only when NacMotionType=0] (deg) 6 RotSpeed(2) - Rotational speed of rotor in rotor coordinates [used only when RotorMotionType=0] (rpm) @@ -86,10 +86,11 @@ True HAWTprojection(1) - True if turbine is a horizontal axis tu ----- Combined-Case Analysis [used only when AnalysisType=3, numTurbines=1] ------------- 0 NumCases - Number of cases to run HWndSpeed PLExp RotSpd Pitch Yaw dT Tmax DOF Amplitude Frequency -(m/s) (-) (rpm) (deg) (deg) (s) (s) (-) (-) (Hz) +(m/s) (-) (rpm) (deg) (deg) (s) (s) (-) (m or rad) (Hz) ----- Output Settings ------------------------------------------------------------------- "ES15.8E2" OutFmt - Format used for text tabular output, excluding the time channel. Resulting field should be 10 characters. (quoted string) 2 OutFileFmt - Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 3: both} -0 WrVTK - VTK visualization data output: (switch) {0=none; 1=animation} +0 WrVTK - VTK visualization data output: (switch) {0=none; 1=init; 2=animation} +1 WrVTK_Type - VTK visualization data type: (switch) {1=surfaces; 2=lines; 3=both} 2 VTKHubRad - HubRadius for VTK visualization (m) -7,-4,0,21,8,8 VTKNacDim - Nacelle Dimension for VTK visualization x0,y0,z0,Lx,Ly,Lz (m) diff --git a/docs/source/user/aerodyn/figs/ad_blade_geom.png b/docs/source/user/aerodyn/figs/aerodyn_blade_geom.png similarity index 100% rename from docs/source/user/aerodyn/figs/ad_blade_geom.png rename to docs/source/user/aerodyn/figs/aerodyn_blade_geom.png diff --git a/docs/source/user/aerodyn/figs/ad_blade_local_cs.png b/docs/source/user/aerodyn/figs/aerodyn_blade_local_cs.png similarity index 100% rename from docs/source/user/aerodyn/figs/ad_blade_local_cs.png rename to docs/source/user/aerodyn/figs/aerodyn_blade_local_cs.png diff --git a/docs/source/user/aerodyn/figs/ad_driver_geom.png b/docs/source/user/aerodyn/figs/aerodyn_driver_geom.png similarity index 100% rename from docs/source/user/aerodyn/figs/ad_driver_geom.png rename to docs/source/user/aerodyn/figs/aerodyn_driver_geom.png diff --git a/docs/source/user/aerodyn/figs/aerodyn_not_ad.README.txt b/docs/source/user/aerodyn/figs/aerodyn_not_ad.README.txt new file mode 100644 index 0000000000..4e929b42df --- /dev/null +++ b/docs/source/user/aerodyn/figs/aerodyn_not_ad.README.txt @@ -0,0 +1,5 @@ + +The AeroDyn documentation should not reference images that are prefixed with "ad_". +This can lead to ad-blockers in browsers blocking these images. Instead, simply +use the prefix "aerodyn_". +See https://github.com/OpenFAST/openfast/issues/912 for details. diff --git a/docs/source/user/aerodyn/figs/ad_output_channel.pdf b/docs/source/user/aerodyn/figs/aerodyn_output_channel.pdf similarity index 100% rename from docs/source/user/aerodyn/figs/ad_output_channel.pdf rename to docs/source/user/aerodyn/figs/aerodyn_output_channel.pdf diff --git a/docs/source/user/aerodyn/figs/ad_tower_geom.png b/docs/source/user/aerodyn/figs/aerodyn_tower_geom.png similarity index 100% rename from docs/source/user/aerodyn/figs/ad_tower_geom.png rename to docs/source/user/aerodyn/figs/aerodyn_tower_geom.png diff --git a/docs/source/user/aerodyn/input.rst b/docs/source/user/aerodyn/input.rst index a49686c455..49071ea999 100644 --- a/docs/source/user/aerodyn/input.rst +++ b/docs/source/user/aerodyn/input.rst @@ -67,7 +67,7 @@ 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). When ``WakeMod`` is set +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. @@ -179,13 +179,20 @@ Dynamic Blade-Element/Momentum Theory Options ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The input parameters in this section are used only when ``WakeMod = 2``. +The theory is described in :numref:`AD_DBEMT`. + +There are three options available for ``DBEMT_Mod``: + +- ``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. + -Set ``DBEMT_Mod`` to 1 for the constant-tau1 model, set ``DBEMT_Mod`` to 2 -to use a model where tau1 varies with time, or set ``DBEMT_Mod`` to 3 -to use a continuous-state model with constant tau1. -If ``DBEMT_Mod=1`` (constant-tau1 model) or ``DBEMT_Mod=3`` (continuous-state constant-tau1 model), -set ``tau1_const`` to the time constant to use for DBEMT. OLAF -- cOnvecting LAgrangian Filaments (Free Vortex Wake) Theory Options ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -207,15 +214,15 @@ The input parameters in this section are used only when ``AFAeroMod ``UAMod`` determines the UA model. It has the following options: -- ``1``: the original theoretical developments of B-L (**not currently functional**), -- ``2``: the extensions to B-L developed by González -- ``3``: the extensions to B-L developed by Minnema/Pierce -- ``4``: a continuous-state model developed by Hansen, Gaunna, and Madsen (HGM) -- ``5``: a model similar to HGM with an additional state for vortex generation -- ``6``: Oye's dynamic stall model -- ``7``: Boeing-Vertol model +- ``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) +- ``4``: 4-states continuous-time B-L model developed by Hansen, Gaunna, and Madsen (HGM). NOTE: might require smaller time steps until a stiff integrator is implemented. +- ``5``: 5-states continuous-time B-L model similar to HGM with an additional state for vortex generation +- ``6``: 1-state continuous-time developed by Oye +- ``7``: discrete-time Boeing-Vertol (BV) model -The models are described in :numref:`AD_UA`. +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`. **While all of the UA models are documented in this @@ -371,10 +378,10 @@ quantities are actually output at these nodes. .. _ad_tower_geom: -.. figure:: figs/ad_tower_geom.png +.. figure:: figs/aerodyn_tower_geom.png :width: 60% :align: center - :alt: ad_tower_geom.png + :alt: aerodyn_tower_geom.png AeroDyn Tower Geometry @@ -740,10 +747,10 @@ See :numref:`ad_blade_geom`. Twist is shown in :numref:`ad_blade_local_cs` of :n .. _ad_blade_geom: -.. figure:: figs/ad_blade_geom.png +.. figure:: figs/aerodyn_blade_geom.png :width: 90% :align: center - :alt: ad_blade_geom.png + :alt: aerodyn_blade_geom.png AeroDyn Blade Geometry – Left: Side View; Right: Front View (Looking Downwind) diff --git a/docs/source/user/aerodyn/theory.rst b/docs/source/user/aerodyn/theory.rst index dfa632f1c9..16d095bc91 100644 --- a/docs/source/user/aerodyn/theory.rst +++ b/docs/source/user/aerodyn/theory.rst @@ -14,6 +14,98 @@ Steady BEM The steady blade element momentum (BEM) equations are solved as a constrained equation, and the formulation follows the description from Ning :cite:`ad-Ning:2014`. + +.. _AD_DBEMT: + +Dynamic BEM Theory (DBEMT) +~~~~~~~~~~~~~~~~~~~~~~~~~~ + + + +Two equivalent versions of Oye's dynamic inflow model are implemented in AeroDyn. +The first one uses discrete time, it can be used with the constant-tau1 model +(``DBEMT_Mod=1``) or the varying-tau1 model (``DBEMT_Mod=2``), but it cannot be used for linearization. +The second version uses a continuous-time state-space formulation (``DBEMT_Mod=1``), it assumes a constant-tau1, and can be used for linearization. +For a same value of :math:`\tau_1`, the discrete-time and continuous-time formulations returns exactly the same results. + + + + + +Oye's dynamic inflow model consists of two first-order differential equations (see :cite:`ad-Branlard:book`): + +.. math:: + \begin{align} + \boldsymbol{W}_\text{int}+\tau_1 \boldsymbol{\dot{W}}_\text{int} + &= + \boldsymbol{W}_\text{qs} + k \tau_1 \boldsymbol{\dot{W}}_\text{qs} \\ + \boldsymbol{W}+\tau_2 \boldsymbol{\dot{W}} + &= + \boldsymbol{W}_\text{int} + \end{align} + +where +:math:`\boldsymbol{W}` is the dynamic induction vector at the rotor (at a given blade position and radial position), +:math:`\boldsymbol{W}_\text{qs}` is the quasi-steady induction, +:math:`\boldsymbol{W}_\text{int}` is an intermediate value coupling the quasi-steady and the actual inductions (may be discontinuous if the quasi-steady indution is discontinuous). +and +:math:`(\dot{\ })` represents the time derivative. +The coupling constant :math:`k`, with values between 0 and 1, is usually chosen as :math:`k=0.6`. +Oye's dynamic inflow model relies on two time constants, :math:`\tau_1` and :math:`\tau_2` : + +.. math:: + \tau_1=\frac{1.1}{1-1.3 \min(\overline{a},0.5)} \frac{R}{\overline{U}_0} + , \qquad + \tau_2 =\left[ 0.39-0.26\left(\frac{r}{R}\right)^2\right] \tau_1 + +where :math:`R` is the rotor radius, :math:`\overline{U}_0` is the average wind speed over the rotor, :math:`\overline{a}` is the average axial induction over the rotor, and :math:`r` is the radial position along the blade. +For ``DBEMT_Mod=1`` or ``DBEMT_Mod=3``, the user needs to provide the value of :math:`\tau_1`. + + + + +The continuous-time state-space formulation of the dynamic inflow model (``DBEMT_Mod=3``) was derived in :cite:`ad-Branlard:2022`. + +.. math:: + \begin{align} + \begin{bmatrix} + \boldsymbol{\dot{W}}_\text{red}\\ + \boldsymbol{\dot{W}}\\ + \end{bmatrix} + = + \begin{bmatrix} + -\frac{1}{\tau_1}\boldsymbol{I}_2 & \boldsymbol{0} \\ + \frac{1}{\tau_2}\boldsymbol{I}_2 & + -\frac{1}{\tau_2}\boldsymbol{I}_2 \\ + \end{bmatrix} + \begin{bmatrix} + \boldsymbol{W}_\text{red}\\ + \boldsymbol{W}\\ + \end{bmatrix} + + + \begin{bmatrix} + \frac{1-k}{\tau_1} \\ + \frac{k}{\tau_2}\\ + \end{bmatrix} + \boldsymbol{W}_\text{qs} + \end{align} + +where +:math:`\boldsymbol{I}_2` is the 2x2 identity matrix, +:math:`\boldsymbol{W}_\text{red}` is the reduced induction which is a continuous, scaled, and lagged version of the quasi-steady induction, defined as: + +.. math:: + \boldsymbol{W}_\text{int} = \boldsymbol{W}_\text{red} + k \boldsymbol{W}_\text{qs} + + +The discrete-time version of the model is documented in the unpublished manual of DBEMT. +The current discrete-time formulation is complex and in the future it can be simplified by using :math:`\boldsymbol{W}_\text{red}`. + + + + + + .. _AD_twr_shadow: Tower shadow models diff --git a/docs/source/user/aerodyn/theory_ua.rst b/docs/source/user/aerodyn/theory_ua.rst index 7c66917bb8..da05583613 100644 --- a/docs/source/user/aerodyn/theory_ua.rst +++ b/docs/source/user/aerodyn/theory_ua.rst @@ -197,8 +197,11 @@ Two variants are implemented in the Unsteady Aerodynamic module. These two (comp Beddoes-Leishman 4-states model (UAMod=4) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The 4-states (incompressible) dynamic stall model from Hansen-Gaunaa-Madsen (HGM) is described in :cite:`ad-Hansen:2004` and enabled using ``UAMod=4``. The model uses :math:`C_l` as main physical quantity. -Linearization of the model will be available in the future. +The 4-states (incompressible) dynamic stall model as implemented in OpenFAST is described in :cite:`ad-Branlard:2022` (the model differs slithgly from the original formulation from Hansen-Gaunaa-Madsen (HGM) :cite:`ad-Hansen:2004`). +The model is enabled using ``UAMod=4``. The model uses :math:`C_l` as main physical quantity. +Linearization of the model is available. + +NOTE: this model might require smaller time steps until a stiff integrator is implemented in AeroDyn-UA. **State equation:** @@ -225,6 +228,9 @@ with \end{aligned} + + + **Output equation:** The unsteady airfoil coefficients :math:`C_{l,\text{dyn}}`, :math:`C_{d,\text{dyn}}`, @@ -233,8 +239,9 @@ The unsteady airfoil coefficients .. math:: \begin{aligned} - C_{l,\text{dyn}}(t) &= x_4 (\alpha_E-\alpha_0) C_{l,\alpha} + (1-x_4) C_{l,{fs}}(\alpha_E)+ \pi T_u \omega \\ - C_{d,\text{dyn}}(t) &= C_d(\alpha_E) + (\alpha_{ac}-\alpha_E) C_{l,\text{dyn}} + \left[ C_d(\alpha_E)-C_d(\alpha_0)\right ] \Delta C_{d,f}'' \\ + C_{l,\text{dyn}}(t) &= C_{l,\text{circ}} + \pi T_u \omega \\ + % C_{d,\text{dyn}}(t) &= C_d(\alpha_E) + (\alpha_{ac}-\alpha_E) C_{l,\text{dyn}} + \left[ C_d(\alpha_E)-C_d(\alpha_0)\right ] \Delta C_{d,f}'' \\ + C_{d,\text{dyn}}(t) &= C_d(\alpha_E) + \left[(\alpha_{ac}-\alpha_E) +T_u \omega \right]C_{l,\text{circ}} + \left[ C_d(\alpha_E)-C_d(\alpha_0)\right ] \Delta C_{d,f}'' \\ % C_{m,\text{dyn}}(t) &= C_m(\alpha_E) + C_{l,\text{dyn}} \Delta C_{m,f}'' - \frac{\pi}{2} T_u \omega\\ C_{m,\text{dyn}}(t) &= C_m(\alpha_E) - \frac{\pi}{2} T_u \omega\\ \end{aligned} @@ -245,7 +252,8 @@ with: \begin{aligned} \Delta C_{d,f}'' &= \frac{\sqrt{f_s^{st}(\alpha_E)}-\sqrt{x_4}}{2} - \frac{f_s^{st}(\alpha_E)-x_4}{4} ,\qquad - x_4\ge 0 + x_4\ge 0 \\ + C_{l,\text{circ}}&= x_4 (\alpha_E-\alpha_0) C_{l,\alpha} + (1-x_4) C_{l,{\text{fs}}}(\alpha_E) \end{aligned} @@ -258,7 +266,7 @@ Beddoes-Leishman 5-states model (UAMod=5) The 5-states (incompressible) dynamic stall model is similar to the Beddoes-Leishman 4-states model (UAMod=4), but adds a 5th state to represent vortex generation. It is enabled using ``UAMod=5``. The model uses :math:`C_n` and :math:`C_c` as main physical quantities. -Linearization of the model will be available in the future. +Linearization of the model is available. @@ -272,7 +280,7 @@ Oye model (UAMod=6) Oye's dynamic stall model is a one-state (continuous) model, formulated in :cite:`ad-Oye:1991` and described e.g. in :cite:`ad-Branlard:book`. The model attempts to capture trailing edge stall. -Linearization of the model will be available in the future. +Linearization of the model is available. **State equation:** diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index 2e39de8561..fbc35bdde2 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -10,13 +10,69 @@ The line number corresponds to the resulting line number after all changes are i Thus, be sure to implement each in order so that subsequent line numbers are correct. -OpenFAST v3.2.0 to OpenFAST `dev` +OpenFAST v3.3.0 to OpenFAST `dev` ---------------------------------- None +OpenFAST v3.2.0 to OpenFAST v3.3.0 +---------------------------------- + +============================================= ==== ================= ====================================================================================================================================================================================================== +Added in OpenFAST v3.3.0 +--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- +Module Line Flag Name Example Value +============================================= ==== ================= ====================================================================================================================================================================================================== +AeroDyn driver 54\* WrVTK_Type 1 WrVTK_Type - VTK visualization data type: (switch) {1=surfaces; 2=lines; 3=both} +FAST.Farm 9 ModWaveField 2 Mod_WaveField Wave field handling (-) (switch) {1: use individual HydroDyn inputs without adjustment, 2: adjust wave phases based on turbine offsets from farm origin} +FAST.Farm 10 Mod_SharedMooring 0 Mod_SharedMooring Shared mooring system model (switch) {0: None, 3=MoorDyn}} +FAST.Farm 13 na ------ SHARED MOORING SYSTEM ------ [used only for Mod_SharedMoor>0] +FAST.Farm 14 SharedMoorFile "" SharedMoorFile Name of file containing shared mooring system input parameters (quoted string) [used only when Mod_SharedMooring > 0] +FAST.Farm 15 DT_Mooring 0.04 DT_Mooring Time step for farm-level mooring coupling with each turbine (s) [used only when Mod_SharedMooring > 0] +============================================= ==== ================= ====================================================================================================================================================================================================== + +\*Exact line number depends on number of entries in various preceeding tables. + + +============================================= ==== =============== ======================================================================================================================================================================================================== +Modified in OpenFAST v3.3.0 +--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- +Module Line Flag Name Example Value +============================================= ==== =============== ======================================================================================================================================================================================================== +MoorDyn\& 5 na Name Diam MassDen EA BA/-zeta EI Cd Ca CdAx CaAx +MoorDyn\& 6 na (-) (m) (kg/m) (N) (N-s/-) (-) (-) (-) (-) (-) +MoorDyn\& 7 na main 0.0766 113.35 7.536E8 -1.0 0 2.0 0.8 0.4 0.25 +MoorDyn\& 8\* na ---------------------- POINTS -------------------------------- +MoorDyn\& 9\* na ID Attachment X Y Z M V CdA CA +MoorDyn\& 10\* na (-) (-) (m) (m) (m) (kg) (m^3) (m^2) (-) +MoorDyn\& 11\* na 1 Fixed 418.8 725.383 -200.0 0 0 0 0 +MoorDyn\& 17\* na ---------------------- LINES -------------------------------------- +MoorDyn\& 18\* na ID LineType AttachA AttachB UnstrLen NumSegs Outputs +MoorDyn\& 19\* na (-) (-) (-) (-) (m) (-) (-) +MoorDyn\& 20\* na 1 main 1 4 835.35 20 - +============================================= ==== =============== ======================================================================================================================================================================================================== + +\&MoorDyn has undergone an extensive revision that leaves few lines unchanged. We recommend looking at a sample input file for the 5MW_OC4Semi_WSt_WavesWN regression test for reference rather than line by line changes in the above tables. + + +============================================= ==== =============== ======================================================================================================================================================================================================== +Removed in OpenFAST v3.3.0 +--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- +Module Line Flag Name Example Value +============================================= ==== =============== ======================================================================================================================================================================================================== +MoorDyn\& 5 NTypes 1 NTypes - number of LineTypes +MoorDyn\& 10\* NConnects 6 NConnects - number of connections including anchors and fairleads +MoorDyn\& 20\* NLines 3 NLines - number of line objects +============================================= ==== =============== ======================================================================================================================================================================================================== + +\*Exact line number depends on number of entries in various preceeding tables. + +\&MoorDyn has undergone an extensive revision that leaves few lines unchanged. We recommend looking at a sample input file for the 5MW_OC4Semi_WSt_WavesWN regression test for reference rather than line by line changes in the above tables. + + + OpenFAST v3.1.0 to OpenFAST v3.2.0 ---------------------------------- @@ -303,13 +359,23 @@ Modified in OpenFAST v2.5.0 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------- Module Line Flag Name / section Example Value ============================ ====== ================================================ ==================================================================================== -MoorDyn na added CtrlChan column in LINE PROPERTIES table .. code-block:: none - - Line LineType UnstrLen NumSegs NodeAnch NodeFair Outputs CtrlChan - (-) (-) (m) (-) (-) (-) (-) (-) - 1 main 835.35 20 1 4 - 0 +MoorDyn na added CtrlChan column in LINE PROPERTIES table ============================ ====== ================================================ ==================================================================================== +============== ====== =============== ============== ============================================================================================================================================================================= +Renamed in OpenFAST v2.5.0 +---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- +Module Line Previous Name New Name Example Value +============== ====== =============== ============== ============================================================================================================================================================================= +InflowWind 17 Filename FileName_Uni "Shr11_30.wnd" FileName_Uni - Filename of time series data for uniform wind field. (-) +InflowWind 18 RefHt RefHt_Uni 90 RefHt_Uni - Reference height for horizontal wind speed (m) +InflowWind 21 Filename FileName_BTS "unused" FileName_BTS - Name of the Full field wind file to use (.bts) (-) +InflowWind 23 Filename FileNameRoot "unused" 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 +InflowWind 35 RefHt RefHt_Hawc 90 RefHt_Hawc - reference height; the height (in meters) of the vertical center of the grid (m) +InflowWind 47 PLExp PLExp_Hawc 0.2 PLExp_Hawc - Power law exponent (-) (used for PL wind profile type only) +InflowWind 49 InitPosition(x) XOffset 0 XOffset - Initial offset in +x direction (shift of wind box) +============== ====== =============== ============== ============================================================================================================================================================================= + OpenFAST v2.3.0 to OpenFAST v2.4.0 @@ -343,11 +409,6 @@ Modified in OpenFAST v2.4.0 Module Line New Flag Name Example Value Previous Flag Name/Value ============== ==== ================== ======================================================================================================================================================= ========================= AirFoilTables 40\* filtCutOff "DEFAULT" filtCutOff - Reduced frequency cut-off for low-pass filtering the AoA input to UA, as well as the 1st and 2nd deriv (-) [default = 0.5] [default = 20] -InflowWind 17 Filename_Uni "unused" Filename_Uni - Filename of time series data for uniform wind field. (-) Filename -InflowWind 18 RefHt_Uni 90 RefHt_Uni - Reference height for horizontal wind speed (m) RefHt -InflowWind 35 RefHt_Hawc 90 RefHt_Hawc - reference height; the height (in meters) of the vertical center of the grid (m) RefHt -InflowWind 47 PLExp_Hawc 0.2 PLExp_Hawc - Power law exponent (-) (used for PL wind profile type only) PLExp -InflowWind 49 XOffset 0 XOffset - Initial offset in +x direction (shift of wind box) InitPosition(x) ============== ==== ================== ======================================================================================================================================================= ========================= \*non-comment line count, excluding lines contained if NumCoords is not 0. diff --git a/docs/source/user/fast.farm/InputFiles.rst b/docs/source/user/fast.farm/InputFiles.rst index 8b353e282d..8f66f507e5 100644 --- a/docs/source/user/fast.farm/InputFiles.rst +++ b/docs/source/user/fast.farm/InputFiles.rst @@ -34,6 +34,8 @@ sections: - Super Controller +- Shared Moorings + - Ambient Wind - Wind Turbines @@ -95,6 +97,15 @@ ambient wind data as defined by the FAST.Farm interface to the **[Mod_AmbWind=3]**. The distinct Ambient Wind subsections below pertain to each option. +**Mod_WaveField** [switch] indicates how the wave field should be treated. The +two options are: 1) use individual HydroDyn inputs at each turbine without +adjustment, 2) adjust wave phases based on turbine offsets from wind farm +origin. + +**Mod_SharedMooring** [switch] indicates if a farm level mooring line system +interconnects turbines. There are presently two options: 0) No shared moorings, +3) MoorDyn. + Super Controller ~~~~~~~~~~~~~~~~ @@ -108,6 +119,25 @@ turbine controllers defined in the style of the DISCON dynamic library of the DNV GL’s Bladed wind turbine software package, with minor modification. See :numref:`FF:sec:SupCon` for more information. +Shared Moorings +~~~~~~~~~~~~~~~ + +Shared mooring lines running between platforms introduce a coupling between the +platforms that operates on the same time scales as a platform's interaction with +a regular mooring system (typically resolved at a time step of 10--30 ms in +OpenFAST simulations). See :numref:`MoorDyn` for more information. + +**SharedMoorFile** [quoted string] sets the name and location of the MoorDyn +input file for the mooring lines in the wind farm. It is only used if +**Mod_SharedMooring** = 3. **The file name must be in quotations** and can +contain an absolute or a relative path. The mooring lines then connect to each +of the wind turbines in the farm. See `MoorDyn with FAST.Farm +`_ +documentation for details on the input file at the farm level. + +**DT_Mooring** (sec) sets the timestep for the shared mooring connections with +MoorDyn. + .. _FF:Input:VTK: Ambient Wind: Precursor in Visualization Toolkit Format diff --git a/docs/source/user/fast.farm/examples/FAST.Farm--input.dat b/docs/source/user/fast.farm/examples/FAST.Farm--input.dat index 35a5462439..c205f51084 100644 --- a/docs/source/user/fast.farm/examples/FAST.Farm--input.dat +++ b/docs/source/user/fast.farm/examples/FAST.Farm--input.dat @@ -6,8 +6,13 @@ FATAL AbortLevel Error level when simulation should abort (string) {"WAR 2000.0 TMax Total run time (s) [>=0.0] False UseSC Use a super controller? (flag) 1 Mod_AmbWind Ambient wind model (-) (switch) {1: high-fidelity precursor in VTK format, 2: one InflowWind module, 3: multiple instances of InflowWind module} +2 Mod_WaveField Wave field handling (-) (switch) {1: use individual HydroDyn inputs without adjustment, 2: adjust wave phases based on turbine offsets from farm origin} +0 Mod_SharedMooring Shared mooring system model (switch) {0: None, 3=MoorDyn}} --- SUPER CONTROLLER --- [used only for UseSC=True] "SC_DLL.dll" SC_FileName Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms (quoted string) +--- SHARED MOORING SYSTEM --- [used only for Mod_SharedMoor>0] +"" SharedMoorFile Name of file containing shared mooring system input parameters (quoted string) [used only when Mod_SharedMooring > 0] +0.04 DT_Mooring Time step for farm-level mooring coupling with each turbine (s) [used only when Mod_SharedMooring > 0] --- AMBIENT WIND: PRECURSOR IN VTK FORMAT --- [used only for Mod_AmbWind=1] 2.0 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] 0.5 DT_High-VTK Time step for high-resolution wind data input files (s) [>0.0] "/AmbWind/steady" WindFilePath Path name to wind data files from precursor (string) diff --git a/docs/source/user/index.rst b/docs/source/user/index.rst index 59736b2fe6..b30050a131 100644 --- a/docs/source/user/index.rst +++ b/docs/source/user/index.rst @@ -24,7 +24,10 @@ General Workshop material, legacy documentation, and other resources are listed below. -- `Workshop Presentations `_ +- `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 `_ @@ -51,6 +54,7 @@ Documentation covers usage of models, underlying theory, and in some cases modul ElastoDyn HydroDyn InflowWind + MoorDyn ServoDyn Structural Control TurbSim diff --git a/docs/source/user/inflowwind/driver.rst b/docs/source/user/inflowwind/driver.rst index b0ef7a0170..da2783c243 100644 --- a/docs/source/user/inflowwind/driver.rst +++ b/docs/source/user/inflowwind/driver.rst @@ -7,7 +7,7 @@ Command-line syntax for InflowWind driver: :: - InlowWind_Driver [options] + InflowWind_Driver [options] where: -- Name of driver input file to use options: /ifw -- treat as name of InflowWind input file (no driver input file) diff --git a/docs/source/user/moordyn/index.rst b/docs/source/user/moordyn/index.rst new file mode 100644 index 0000000000..52730e521a --- /dev/null +++ b/docs/source/user/moordyn/index.rst @@ -0,0 +1,12 @@ +.. _MoorDyn: + +MoorDyn Users Guide +==================== + +A standalone C++ version of MoorDyn is also available outside the OpenFAST +repository. The documentation for the C++ version covers the input file format +(`MoorDyn usage `_, specifically the section for V2) +usage of MoorDyn at the FAST.Farm level +(`MoorDyn with FAST.Farm `_), +and links to publications with the relevant theory. + diff --git a/glue-codes/fast-farm/CMakeLists.txt b/glue-codes/fast-farm/CMakeLists.txt index 40507fc30c..c6ad9ffc75 100644 --- a/glue-codes/fast-farm/CMakeLists.txt +++ b/glue-codes/fast-farm/CMakeLists.txt @@ -44,12 +44,16 @@ set_property(TARGET FAST.Farm PROPERTY LINKER_LANGUAGE Fortran) string(TOUPPER ${CMAKE_Fortran_COMPILER_ID} _compiler_id) string(TOUPPER ${CMAKE_BUILD_TYPE} _build_type) -if (${_compiler_id} STREQUAL "GNU" AND ${_build_type} STREQUAL "RELEASE") +if (${_compiler_id} STREQUAL "GNU" AND NOT ${VARIABLE_TRACKING}) # With variable tracking enabled, the compile step frequently aborts on large modules and - # restarts with this option off. Disabling in Release mode avoids this problem when compiling with - # full optimizations, but leaves it enabled for RelWithDebInfo which adds both -O2 and -g flags. + # restarts with this option off. Disabling avoids this problem when compiling with + # full optimizations. However, variable tracking should be enabled when actively debugging + # for better runtime debugging output. # https://gcc.gnu.org/onlinedocs/gcc/Debugging-Options.html - set_source_files_properties(src/FAST_Farm_Types.f90 src/FASTWrapper_Types.f90 PROPERTIES COMPILE_FLAGS "-fno-var-tracking -fno-var-tracking-assignments") + set_source_files_properties(src/FAST_Farm_Types.f90 src/FASTWrapper_Types.f90 src/FASTWrapper.f90 PROPERTIES COMPILE_FLAGS "-fno-var-tracking -fno-var-tracking-assignments") + set_source_files_properties(src/FAST_Farm_IO.f90 PROPERTIES COMPILE_FLAGS "-fno-var-tracking -fno-var-tracking-assignments") + set_source_files_properties(src/FAST_Farm_Subs.f90 PROPERTIES COMPILE_FLAGS "-fno-var-tracking -fno-var-tracking-assignments") + set_source_files_properties(src/FAST_Farm.f90 PROPERTIES COMPILE_FLAGS "-fno-var-tracking -fno-var-tracking-assignments") endif() if (${_compiler_id} MATCHES "^INTEL" AND ${_build_type} STREQUAL "RELEASE" AND NOT WIN32) # Compilation hangs on FAST_Farm_Types.f90 with -O3 on linux (on some hardware) diff --git a/glue-codes/fast-farm/src/FASTWrapper.f90 b/glue-codes/fast-farm/src/FASTWrapper.f90 index 2a922ed675..9e14bdc971 100644 --- a/glue-codes/fast-farm/src/FASTWrapper.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper.f90 @@ -44,6 +44,8 @@ MODULE FASTWrapper PUBLIC :: FWrap_t0 ! call to compute outputs at t0 [and initialize some more variables] PUBLIC :: FWrap_Increment ! call to update states to n+1 and compute outputs at n+1 + PUBLIC :: FWrap_SetInputs + PUBLIC :: FWrap_CalcOutput CONTAINS @@ -140,6 +142,7 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init !.... multi-turbine options .... ExternInitData%TurbineID = InitInp%TurbNum ExternInitData%TurbinePos = InitInp%p_ref_Turbine + ExternInitData%WaveFieldMod = InitInp%WaveFieldMod ExternInitData%FarmIntegration = .true. ExternInitData%RootName = InitInp%RootName @@ -286,11 +289,11 @@ end subroutine cleanup 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. -subroutine FWrap_SetParameters(InitInp, p, dt_FAST, InitInp_dt_low, ErrStat, ErrMsg) +subroutine FWrap_SetParameters(InitInp, p, dt_FAST, dt_caller, ErrStat, ErrMsg) TYPE(FWrap_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(FWrap_ParameterType), INTENT(INOUT) :: p !< Parameters REAL(DbKi), INTENT(IN ) :: dt_FAST !< time step for FAST - REAL(DbKi), INTENT(IN ) :: InitInp_dt_low !< time step for FAST.Farm + REAL(DbKi), INTENT(IN ) :: dt_caller !< time step that FWrap will be called at by FAST.Farm (if MooringMod>0, this will be smaller than DT_low) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -317,22 +320,22 @@ subroutine FWrap_SetParameters(InitInp, p, dt_FAST, InitInp_dt_low, ErrStat, Err ! p%n_FAST_low has to be set AFTER we initialize FAST, because we need to know what the FAST time step is going to be. - IF ( EqualRealNos( dt_FAST, InitInp_dt_low ) ) THEN + IF ( EqualRealNos( dt_FAST, dt_caller ) ) THEN p%n_FAST_low = 1 ELSE - IF ( dt_FAST > InitInp_dt_low ) THEN + IF ( dt_FAST > dt_caller ) THEN ErrStat = ErrID_Fatal ErrMsg = "The FAST time step ("//TRIM(Num2LStr(dt_FAST))// & - " s) cannot be larger than FAST.Farm time step ("//TRIM(Num2LStr(InitInp_dt_low))//" s)." + " s) cannot be larger than FAST.Farm time step ("//TRIM(Num2LStr(dt_caller))//" s)." ELSE ! calculate the number of subcycles: - p%n_FAST_low = NINT( InitInp_dt_low / dt_FAST ) + p%n_FAST_low = NINT( dt_caller / dt_FAST ) ! let's make sure the FAST DT is an exact integer divisor of the global (FAST.Farm) time step: - IF ( .NOT. EqualRealNos( InitInp_dt_low, dt_FAST * p%n_FAST_low ) ) THEN + IF ( .NOT. EqualRealNos( dt_caller, dt_FAST * p%n_FAST_low ) ) THEN ErrStat = ErrID_Fatal ErrMsg = "The FASTWrapper module time step ("//TRIM(Num2LStr(dt_FAST))// & - " s) must be an integer divisor of the FAST.Farm time step ("//TRIM(Num2LStr(InitInp_dt_low))//" s)." + " s) must be an integer divisor of the FAST.Farm or farm-level mooring time step ("//TRIM(Num2LStr(dt_caller))//" s)." END IF END IF @@ -411,7 +414,7 @@ END SUBROUTINE FWrap_End 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 + 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) TYPE(FWrap_ParameterType), INTENT(IN ) :: p !< Parameters @@ -451,11 +454,11 @@ SUBROUTINE FWrap_Increment( t, n, u, p, x, xd, z, OtherState, y, m, ErrStat, Err !ELSE ! ! set the inputs needed for FAST - call FWrap_SetInputs(u, m, t) + !call FWrap_SetInputs(u, m, t) <<< moved up into FAST.Farm FARM_UpdateStates - ! call FAST p%n_FAST_low times: - do n_ss = 1, p%n_FAST_low - n_FAST = n*p%n_FAST_low + n_ss - 1 + ! call FAST p%n_FAST_low times (p%n_FAST_low is simply the number of steps to make per wrapper call. It is affected by MooringMod) + do n_ss = 1, p%n_FAST_low + n_FAST = n*p%n_FAST_low + n_ss - 1 CALL FAST_Solution_T( t_initial, n_FAST, m%Turbine, ErrStat2, ErrMsg2 ) call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -463,8 +466,8 @@ SUBROUTINE FWrap_Increment( t, n, u, p, x, xd, z, OtherState, y, m, ErrStat, Err end do ! n_ss - call FWrap_CalcOutput(p, u, y, m, ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !call FWrap_CalcOutput(p, u, y, m, ErrStat2, ErrMsg2) <<< moved up into FAST.Farm FARM_UpdateStates + ! call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !END IF diff --git a/glue-codes/fast-farm/src/FASTWrapper_Registry.txt b/glue-codes/fast-farm/src/FASTWrapper_Registry.txt index 7cf5303c5e..e494a34ea7 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Registry.txt +++ b/glue-codes/fast-farm/src/FASTWrapper_Registry.txt @@ -22,6 +22,7 @@ typedef ^ InitInputType CHARACTER(1024) FASTInFile typedef ^ InitInputType ReKi dr - - - "Radial increment of radial finite-difference grid" m typedef ^ InitInputType DbKi tmax - - - "Simulation length" s typedef ^ InitInputType ReKi p_ref_Turbine {3} - - "Undisplaced global coordinates of this turbine" m +typedef ^ InitInputType 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 ^ InitInputType IntKi n_high_low - - - "Number of high-resolution time steps per low-resolution time step" - typedef ^ InitInputType DbKi dt_high - - - "High-resolution time step" s typedef ^ InitInputType ReKi p_ref_high {3} - - "Position of the origin of the high-resolution spatial domain for this turbine" m @@ -43,6 +44,7 @@ typedef ^ InitInputType SiKi fromSC # 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 DbKi PtfmInit {6} - - "Initial platform position/rotation vector - surge,sway,heave,roll,pitch,yaw - needed for mooring module initInp" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 3e0fc25cc3..113967a4eb 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -41,6 +41,7 @@ MODULE FASTWrapper_Types 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] @@ -62,6 +63,7 @@ MODULE FASTWrapper_Types ! ======================= ! ========= 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 [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] END TYPE FWrap_InitOutputType ! ======================= @@ -145,6 +147,7 @@ SUBROUTINE FWrap_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er 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 @@ -243,6 +246,7 @@ SUBROUTINE FWrap_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err 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 @@ -309,6 +313,8 @@ SUBROUTINE FWrap_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err 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 @@ -422,6 +428,8 @@ SUBROUTINE FWrap_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) @@ -504,12 +512,14 @@ SUBROUTINE FWrap_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, CHARACTER(*), INTENT( OUT) :: 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' ! 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 @@ -562,6 +572,7 @@ SUBROUTINE FWrap_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er 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 @@ -607,6 +618,10 @@ SUBROUTINE FWrap_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er 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 @@ -650,6 +665,7 @@ SUBROUTINE FWrap_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred 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' @@ -663,6 +679,12 @@ SUBROUTINE FWrap_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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 diff --git a/glue-codes/fast-farm/src/FAST_Farm_Registry.txt b/glue-codes/fast-farm/src/FAST_Farm_Registry.txt index 0f20a1d3fd..9f595b55c5 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Registry.txt +++ b/glue-codes/fast-farm/src/FAST_Farm_Registry.txt @@ -17,12 +17,13 @@ usefrom WakeDynamics_Registry.txt usefrom AWAE_Registry.txt usefrom SuperController_Registry.txt -param FAST_Farm/Farm - INTEGER NumFFModules - 4 - "The number of modules available in FAST.Farm" - +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" - # ..... 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 @@ -31,8 +32,13 @@ 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 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" - @@ -79,6 +85,10 @@ typedef ^ ^ DbKi TimeData {:} - - "Array 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" + + # ..... FASTWrapper data ....................................................................................................... typedef ^ FASTWrapper_Data FWrap_ContinuousStateType x - - - "Continuous states" typedef ^ ^ FWrap_DiscreteStateType xd - - - "Discrete states" @@ -122,6 +132,18 @@ typedef ^ ^ DbKi utimes {1} - typedef ^ ^ SC_OutputType y - - - "System outputs" typedef ^ ^ SC_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ logical IsInitialized - .FALSE. - "Has SC_Init been called" +# ..... MD data ....................................................................................................... +typedef ^ MD_Data MD_ContinuousStateType x - - - "Continuous states" +typedef ^ ^ MD_DiscreteStateType xd - - - "Discrete states" +typedef ^ ^ MD_ConstraintStateType z - - - "Constraint states" +typedef ^ ^ MD_OtherStateType OtherSt - - - "Other states" +typedef ^ ^ MD_ParameterType p - - - "Parameters" +typedef ^ ^ MD_InputType u - - - "Extrapolated system inputs" +typedef ^ ^ MD_InputType Input {:} - - "System inputs" +typedef ^ ^ DbKi InputTimes {:} - - "Current time" s +typedef ^ ^ MD_OutputType y - - - "System outputs" +typedef ^ ^ MD_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ logical IsInitialized - .FALSE. - "Has MD_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" - @@ -129,5 +151,6 @@ typedef ^ All_FastFarm_Data FASTWrapper_Data FWrap {:} - - typedef ^ All_FastFarm_Data WakeDynamics_Data WD {:} - - "WakeDynamics (WD) data" - 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" - # ..... 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 6bcae36bee..7203c39134 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 @@ -319,6 +319,19 @@ SUBROUTINE Farm_Initialize( farm, InputFile, ErrStat, ErrMsg ) CALL Cleanup() RETURN END IF + + !............................................................................................................................... + ! 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 + end if !............................................................................................................................... ! step 5: Open output file (or set up output file handling) @@ -537,6 +550,22 @@ SUBROUTINE Farm_ReadPrimaryFile( InputFile, p, WD_InitInp, AWAE_InitInp, SC_Init 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) @@ -554,6 +583,31 @@ SUBROUTINE Farm_ReadPrimaryFile( InputFile, p, WD_InitInp, AWAE_InitInp, SC_Init 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 ) @@ -1367,6 +1421,12 @@ SUBROUTINE Farm_ValidateInput( p, WD_InitInp, AWAE_InitInp, SC_InitInp, ErrStat, 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) @@ -1375,7 +1435,10 @@ SUBROUTINE Farm_ValidateInput( p, WD_InitInp, AWAE_InitInp, SC_InitInp, ErrStat, ! --- 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%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) @@ -1544,7 +1607,8 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y ! local variables type(FWrap_InitInputType) :: FWrap_InitInp - type(FWrap_InitOutputType) :: FWrap_InitOut + type(FWrap_InitOutputType) :: FWrap_InitOut + REAL(DbKi) :: FWrap_Interval !< Coupling interval that FWrap is called at (affected by MooringMod) INTEGER(IntKi) :: nt ! loop counter for rotor number INTEGER(IntKi) :: ErrStat2 ! Temporary Error status @@ -1582,6 +1646,11 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y allocate(FWrap_InitInp%fromSC(SC_InitOutput%NumSC2Ctrl)) + 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 + else + FWrap_Interval = farm%p%dt_low ! otherwise FASTWrapper will be called at the regular FAST.Farm time step + end if DO nt = 1,farm%p%NumTurbines !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -1590,6 +1659,7 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y FWrap_InitInp%FASTInFile = farm%p%WT_FASTInFile(nt) FWrap_InitInp%p_ref_Turbine = farm%p%WT_Position(:,nt) + FWrap_InitInp%WaveFieldMod = farm%p%WaveFieldMod FWrap_InitInp%TurbNum = nt FWrap_InitInp%RootName = trim(farm%p%OutFileRoot)//'.T'//num2lstr(nt) @@ -1606,7 +1676,7 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y end if ! note that FWrap_Init has Interval as INTENT(IN) so, we don't need to worry about overwriting farm%p%dt_low here: call FWrap_Init( FWrap_InitInp, farm%FWrap(nt)%u, farm%FWrap(nt)%p, farm%FWrap(nt)%x, farm%FWrap(nt)%xd, farm%FWrap(nt)%z, & - farm%FWrap(nt)%OtherSt, farm%FWrap(nt)%y, farm%FWrap(nt)%m, farm%p%dt_low, FWrap_InitOut, ErrStat2, ErrMsg2 ) + farm%FWrap(nt)%OtherSt, farm%FWrap(nt)%y, farm%FWrap(nt)%m, FWrap_Interval, FWrap_InitOut, ErrStat2, ErrMsg2 ) farm%FWrap(nt)%IsInitialized = .true. @@ -1629,6 +1699,268 @@ subroutine cleanup() end subroutine cleanup 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 + + ! local variables + 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' + + + ErrStat = ErrID_None + ErrMsg = "" + + CALL WrScr(" --------- in FARM_InitMD, to initiailze farm-level MoorDyn ------- ") + + + ! sort out how many times FASt and MoorDyn will be called per FAST.Farm time step based on DT_low and DT_mooring + IF ( EqualRealNos( farm%p%dt_mooring, farm%p%DT_low ) ) THEN + farm%p%n_mooring = 1 + ELSE + IF ( farm%p%dt_mooring > farm%p%DT_low ) THEN + ErrStat = ErrID_Fatal + ErrMsg = "The farm mooring coupling time step ("//TRIM(Num2LStr(farm%p%dt_mooring))// & + " s) cannot be larger than FAST.Farm time step ("//TRIM(Num2LStr(farm%p%DT_low))//" s)." + ELSE + ! calculate the number of FAST-MoorDyn subcycles: + farm%p%n_mooring = NINT( farm%p%DT_low / farm%p%dt_mooring ) + + ! let's make sure the FAST DT is an exact integer divisor of the global (FAST.Farm) time step: + IF ( .NOT. EqualRealNos( farm%p%DT_low, farm%p%dt_mooring * farm%p%n_mooring ) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = "The MoorDyn coupling time step, DT_mooring ("//TRIM(Num2LStr(farm%p%dt_mooring))// & + " s) must be an integer divisor of the FAST.Farm time step ("//TRIM(Num2LStr(farm%p%DT_low))//" s)." + END IF + + END IF + END IF + + + !................. + ! MoorDyn initialization inputs... + !................ + !FWrap_InitInp%tmax = farm%p%TMax + !FWrap_InitInp%n_high_low = farm%p%n_high_low + 1 ! Add 1 because the FAST wrapper uses an index that starts at 1 + !FWrap_InitInp%dt_high = farm%p%dt_high + + + MD_InitInp%FileName = farm%p%MD_FileName ! input file name and path + MD_InitInp%RootName = trim(farm%p%OutFileRoot)//'.FarmMD' ! root of output files + 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 + + ! gather spatial initialization inputs for Farm-level MoorDyn + DO nt = 1,farm%p%NumTurbines + MD_InitInp%PtfmInit(:,nt) = farm%FWrap(nt)%m%Turbine%MD%m%PtfmInit ! turbine PRP initial positions and rotations in their respective coordinate systems from each FAST/MD instance + MD_InitInp%TurbineRefPos(:,nt) = farm%p%WT_Position(:,nt) ! reference positions of each turbine in the farm global coordinate system + END DO + + ! These aren't currently handled at the FAST.Farm level, so just give the farm's MoorDyn default values, which can be overwridden by its input file + MD_InitInp%g = 9.81 + MD_InitInp%rhoW = 1025.0 + MD_InitInp%WtrDepth = 0.0 !TODO: eventually connect this to a global depth input variable <<< + + + ! 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 + + ! 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 ) + + 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 ) + 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 ) + + + + ! Set up mesh maps between MoorDyn and floating platforms. + ! (for now assuming ElastoDyn - eventually could differentiate at the turbine level) + + ! 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 + + ! MoorDyn point mesh to/from ElastoDyn (or SubDyn) point mesh + 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' ) + + ! 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' ) + + ! 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 + + + farm%p%Module_Ver( ModuleFF_MD) = MD_InitOut%Ver + + call cleanup() + +contains + subroutine cleanup() + call MD_DestroyInitInput( MD_InitInp, ErrStat2, ErrMsg2 ) + call MD_DestroyInitOutput( MD_InitOut, ErrStat2, ErrMsg2 ) + end subroutine cleanup +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' + + ErrStat = ErrID_None + ErrMsg = "" + + ! ----- extrapolate MD inputs ----- + t_next = t + farm%p%DT_mooring + + ! 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 ) + + ! 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 ) + 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 ) + farm%MD%InputTimes(1) = t_next + + + ! ----- map substructure kinematics to MoorDyn inputs ----- (from mapping called at start of CalcOutputs Solve INputs) + + 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 + + + ! ----- 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 ) + + 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 ) + + + ! ----- map MD load outputs to each turbine's substructure ----- (taken from U FullOpt1...) + do nt = 1,farm%p%NumTurbines + + if (farm%MD%p%nCpldCons(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, & + 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 + + 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 + + +end subroutine Farm_MD_Increment +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine performs the initial call to calculate outputs (at t=0). !! The Initial Calculate Output algorithm: \n !! - In parallel: @@ -1800,23 +2132,33 @@ subroutine FARM_UpdateStates(t, n, farm, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - INTEGER(IntKi) :: nt - INTEGER(IntKi) :: ErrStatWD, ErrStat2 - INTEGER(IntKi), ALLOCATABLE :: ErrStatF(:) ! Temporary Error status + INTEGER(IntKi) :: nt + INTEGER(IntKi) :: n_ss + INTEGER(IntKi) :: n_FMD + REAL(DbKi) :: t2 ! time within the FAST-MoorDyn substepping loop for shared moorings + INTEGER(IntKi) :: ErrStatWD, ErrStatAWAE, ErrStatMD, ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(ErrMsgLen) :: ErrMsgWD - CHARACTER(ErrMsgLen), ALLOCATABLE :: ErrMsgF (:) ! Temporary Error message + CHARACTER(ErrMsgLen) :: ErrMsgAWAE + CHARACTER(ErrMsgLen) :: ErrMsgMD + INTEGER(IntKi), ALLOCATABLE :: ErrStatF(:) ! Temporary Error status for FAST + CHARACTER(ErrMsgLen), ALLOCATABLE :: ErrMsgF (:) ! Temporary Error message for FAST CHARACTER(*), PARAMETER :: RoutineName = 'FARM_UpdateStates' -! REAL(DbKi) :: tm1,tm2,tm3 + REAL(DbKi) :: tm1,tm2,tm3, tm01, tm02, tm03, tmSF, tmSM ! timer variables ErrStat = ErrID_None ErrMsg = "" - allocate ( ErrStatF ( farm%p%NumTurbines + 1 ), STAT=errStat2 ) + allocate ( ErrStatF ( farm%p%NumTurbines ), STAT=errStat2 ) if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for ErrStatF.', errStat, errMsg, RoutineName ) - allocate ( ErrMsgF ( farm%p%NumTurbines + 1 ), STAT=errStat2 ) + allocate ( ErrMsgF ( farm%p%NumTurbines ), STAT=errStat2 ) if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for ErrMsgF.', errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return + + + + !....................................................................................... ! update module states (steps 1. and 2. and 3. and 4. can be done in parallel) !....................................................................................... @@ -1843,57 +2185,166 @@ subroutine FARM_UpdateStates(t, n, farm, ErrStat, ErrMsg) if (errStat >= AbortErrLev) return end if + !-------------------- - ! 3. CALL F_Increment and 4. CALL AWAE_UpdateStates -!#ifdef _OPENMP -! tm1 = omp_get_wtime() -!#endif - !$OMP PARALLEL DO DEFAULT(Shared) Private(nt) !Private(nt,tm2,tm3) - DO nt = 1,farm%p%NumTurbines+1 - if(nt.ne.farm%p%NumTurbines+1) then -!#ifdef _OPENMP -! tm3 = omp_get_wtime() -!#endif - call FWrap_Increment( t, n, farm%FWrap(nt)%u, farm%FWrap(nt)%p, farm%FWrap(nt)%x, farm%FWrap(nt)%xd, farm%FWrap(nt)%z, & - farm%FWrap(nt)%OtherSt, farm%FWrap(nt)%y, farm%FWrap(nt)%m, ErrStatF(nt), ErrMsgF(nt) ) + ! 3. CALL F_Increment (and FARM_MD_Increment) and 4. CALL AWAE_UpdateStates + + + ! set the inputs needed for FAST (these are slow-varying so can just be done once per farm time step) + do nt = 1,farm%p%NumTurbines + call FWrap_SetInputs(farm%FWrap(nt)%u, farm%FWrap(nt)%m, t) + end do + + + ! Original case: no shared moorings + if (farm%p%MooringMod == 0) then + + !#ifdef printthreads + ! tm1 = omp_get_wtime() + !#endif + !$OMP PARALLEL DO DEFAULT(Shared) Private(nt) !Private(nt,tm2,tm3) + DO nt = 1,farm%p%NumTurbines+1 + if(nt.ne.farm%p%NumTurbines+1) then + !#ifdef printthreads + ! tm3 = omp_get_wtime() + !#endif + call FWrap_Increment( t, n, farm%FWrap(nt)%u, farm%FWrap(nt)%p, farm%FWrap(nt)%x, farm%FWrap(nt)%xd, farm%FWrap(nt)%z, & + farm%FWrap(nt)%OtherSt, farm%FWrap(nt)%y, farm%FWrap(nt)%m, ErrStatF(nt), ErrMsgF(nt) ) + + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) ' FWrap_Increment for turbine #'//trim(num2lstr(nt))//' using thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' + !#endif + + else + !#ifdef printthreads + ! tm3 = omp_get_wtime() + !#endif + call AWAE_UpdateStates( t, n, farm%AWAE%u, farm%AWAE%p, farm%AWAE%x, farm%AWAE%xd, farm%AWAE%z, & + farm%AWAE%OtherSt, farm%AWAE%m, ErrStatAWAE, ErrMsgAWAE ) + + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) ' AWAE_UpdateStates using thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' + !#endif + endif -!#ifdef _OPENMP -! tm2 = omp_get_wtime() -! write(*,*) ' FWrap_Increment for turbine #'//trim(num2lstr(nt))//' using thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' -!#endif + END DO + !$OMP END PARALLEL DO - else -!#ifdef _OPENMP -! tm3 = omp_get_wtime() -!#endif - call AWAE_UpdateStates( t, n, farm%AWAE%u, farm%AWAE%p, farm%AWAE%x, farm%AWAE%xd, farm%AWAE%z, & - farm%AWAE%OtherSt, farm%AWAE%m, errStatF(nt), errMsgF(nt) ) - -!#ifdef _OPENMP -! tm2 = omp_get_wtime() -! write(*,*) ' AWAE_UpdateStates using thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' -!#endif - endif + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) 'Total Farm_US took '//trim(num2lstr(tm2-tm1))//' seconds.' + !#endif + + + ! Farm-level moorings case using MoorDyn + else if (farm%p%MooringMod == 3) then - END DO - !$OMP END PARALLEL DO + !#ifdef printthreads + ! tm1 = omp_get_wtime() + !#endif + + ! Set up two parallel sections - one for FAST-MoorDyn steps (FAST portion in parallel for each step), and the other for AWAE. + !$OMP PARALLEL SECTIONS DEFAULT(Shared) + + + ! The first section, for looping through FAST and farm-level MoorDyn time steps + !$OMP SECTION + + !#ifdef printthreads + ! tm3 = omp_get_wtime() + ! tmSF = 0.0_DbKi + ! tmSM = 0.0_DbKi + !#endif + + ! This is the FAST-MoorDyn farm-level substepping loop + do n_ss = 1, farm%p%n_mooring ! do n_mooring substeps (number of FAST/FarmMD steps per Farm time step) + + n_FMD = n*farm%p%n_mooring + n_ss - 1 ! number of the current time step of the call to FAST and MoorDyn + t2 = t + farm%p%DT_mooring*(n_ss - 1) ! current time in the loop + !#ifdef printthreads + ! tm01 = omp_get_wtime() + !#endif + + ! A nested parallel for loop to call each instance of OpenFAST in parallel + !$OMP PARALLEL DO DEFAULT(Shared) Private(nt) + DO nt = 1,farm%p%NumTurbines + call FWrap_Increment( t2, n_FMD, farm%FWrap(nt)%u, farm%FWrap(nt)%p, farm%FWrap(nt)%x, farm%FWrap(nt)%xd, farm%FWrap(nt)%z, & + farm%FWrap(nt)%OtherSt, farm%FWrap(nt)%y, farm%FWrap(nt)%m, ErrStatF(nt), ErrMsgF(nt) ) + END DO + !$OMP END PARALLEL DO + + !#ifdef printthreads + ! tm02 = omp_get_wtime() + !#endif + + ! call farm-level MoorDyn time step here (can't multithread this with FAST since it needs inputs from all FAST instances) + call Farm_MD_Increment( t2, n_FMD, farm, ErrStatMD, ErrMsgMD) + call SetErrStat(ErrStatMD, ErrMsgMD, ErrStat, ErrMsg, 'FARM_UpdateStates') ! MD error status <<<<< + + !#ifdef printthreads + ! tm03 = omp_get_wtime() + ! tmSF = tmSF + tm02-tm01 + ! tmSM = tmSM + tm03-tm02 + !#endif + + end do ! n_ss substepping + + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) ' Turbine and support structure simulations with parent thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' + ! write(*,*) ' Time on FAST sims: '//trim(num2lstr(tmSF))//' s. Time on Farm MoorDyn: '//trim(num2lstr(tmSM))//' seconds' + !#endif + + + ! The second section, for updating AWAE states on a separate thread in parallel with the FAST/MoorDyn time stepping + !$OMP SECTION + + !#ifdef printthreads + ! tm3 = omp_get_wtime() + !#endif + + call AWAE_UpdateStates( t, n, farm%AWAE%u, farm%AWAE%p, farm%AWAE%x, farm%AWAE%xd, farm%AWAE%z, & + farm%AWAE%OtherSt, farm%AWAE%m, ErrStatAWAE, ErrMsgAWAE ) + + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) ' AWAE_UpdateStates using thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' + !#endif + + + !$OMP END PARALLEL SECTIONS + + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) 'Total Farm_US took '//trim(num2lstr(tm2-tm1))//' seconds.' + !#endif + + else + CALL SetErrStat( ErrID_Fatal, 'MooringMod must be 0 or 3.', ErrStat, ErrMsg, RoutineName ) + end if + + ! update error messages from FAST's and AWAE's time steps DO nt = 1,farm%p%NumTurbines - call SetErrStat(ErrStatF(nt), ErrMsgF(nt), ErrStat, ErrMsg, 'T'//trim(num2lstr(nt))//':FARM_UpdateStates') + call SetErrStat(ErrStatF(nt), ErrMsgF(nt), ErrStat, ErrMsg, 'T'//trim(num2lstr(nt))//':FARM_UpdateStates') ! FAST error status END DO + + call SetErrStat(ErrStatAWAE, ErrMsgAWAE, ErrStat, ErrMsg, 'FARM_UpdateStates') ! AWAE error status + + ! calculate outputs from FAST as needed by FAST.Farm + do nt = 1,farm%p%NumTurbines + call FWrap_CalcOutput(farm%FWrap(nt)%p, farm%FWrap(nt)%u, farm%FWrap(nt)%y, farm%FWrap(nt)%m, ErrStat2, ErrMsg2) + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end do - call SetErrStat(ErrStatF(farm%p%NumTurbines+1), ErrMsgF(farm%p%NumTurbines+1), ErrStat, ErrMsg, 'FARM_UpdateStates') - + if (ErrStat >= AbortErrLev) return -!#ifdef _OPENMP -! tm2 = omp_get_wtime() -! write(*,*) 'Total Farm_US took '//trim(num2lstr(tm2-tm1))//' seconds.' -!#endif - end subroutine FARM_UpdateStates - +!---------------------------------------------------------------------------------------------------------------------------------- subroutine Farm_WriteOutput(n, t, farm, ErrStat, ErrMsg) INTEGER(IntKi), INTENT(IN ) :: n !< Time step increment number REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -2334,6 +2785,15 @@ subroutine FARM_End(farm, ErrStat, ErrMsg) end if + !-------------- + ! 5. End farm-level MoorDyn + if (farm%p%MooringMod == 3) 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? + end if + + !....................................................................................... ! close output file !....................................................................................... diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index 9d3cc3ffe4..eba7c5f052 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -37,12 +37,13 @@ MODULE FAST_Farm_Types USE SuperController_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: NumFFModules = 4 ! The number of modules available in FAST.Farm [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumFFModules = 5 ! The number of modules available in FAST.Farm [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_None = 0 ! No module selected [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_SC = 1 ! Super Controller [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_FWrap = 2 ! FAST Wrapper [-] 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 [-] ! ========= 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] @@ -54,6 +55,11 @@ MODULE FAST_Farm_Types 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? [-] 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} [-] + 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 [-] 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 [-] @@ -100,6 +106,8 @@ MODULE FAST_Farm_Types 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 [-] + 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 ! ======================= ! ========= FASTWrapper_Data ======= @@ -155,6 +163,21 @@ MODULE FAST_Farm_Types LOGICAL :: IsInitialized = .FALSE. !< Has SC_Init been called [-] END TYPE SC_Data ! ======================= +! ========= MD_Data ======= + TYPE, PUBLIC :: MD_Data + TYPE(MD_ContinuousStateType) :: x !< Continuous states [-] + TYPE(MD_DiscreteStateType) :: xd !< Discrete states [-] + TYPE(MD_ConstraintStateType) :: z !< Constraint states [-] + TYPE(MD_OtherStateType) :: OtherSt !< Other states [-] + TYPE(MD_ParameterType) :: p !< Parameters [-] + TYPE(MD_InputType) :: u !< Extrapolated system inputs [-] + TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< System inputs [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Current time [s] + TYPE(MD_OutputType) :: y !< System outputs [-] + TYPE(MD_MiscVarType) :: m !< Misc/optimization variables [-] + LOGICAL :: IsInitialized = .FALSE. !< Has MD_Init been called [-] + END TYPE MD_Data +! ======================= ! ========= All_FastFarm_Data ======= TYPE, PUBLIC :: All_FastFarm_Data TYPE(Farm_ParameterType) :: p !< FAST.Farm parameter data [-] @@ -163,6 +186,7 @@ MODULE FAST_Farm_Types TYPE(WakeDynamics_Data) , DIMENSION(:), ALLOCATABLE :: WD !< WakeDynamics (WD) data [-] 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 [-] END TYPE All_FastFarm_Data ! ======================= CONTAINS @@ -204,6 +228,11 @@ SUBROUTINE Farm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg 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) @@ -418,6 +447,11 @@ SUBROUTINE Farm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 @@ -588,6 +622,18 @@ SUBROUTINE Farm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 @@ -898,6 +944,18 @@ SUBROUTINE Farm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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 @@ -1187,7 +1245,7 @@ SUBROUTINE Farm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END SUBROUTINE Farm_UnPackParam SUBROUTINE Farm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Farm_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(Farm_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(Farm_MiscVarType), INTENT(INOUT) :: DstMiscData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1241,6 +1299,38 @@ SUBROUTINE Farm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) 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 ) @@ -1260,6 +1350,18 @@ SUBROUTINE Farm_DestroyMisc( MiscData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) +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), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%MD_2_FWrap) ENDIF END SUBROUTINE Farm_DestroyMisc @@ -1314,6 +1416,53 @@ SUBROUTINE Farm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S 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 @@ -1393,6 +1542,88 @@ SUBROUTINE Farm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S 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 ) @@ -1484,6 +1715,118 @@ SUBROUTINE Farm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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 ) @@ -4852,9 +5195,9 @@ SUBROUTINE Farm_UnPackSC_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Xferred = Int_Xferred + 1 END SUBROUTINE Farm_UnPackSC_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 + 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 @@ -4863,28 +5206,1063 @@ SUBROUTINE Farm_CopyAll_FastFarm_Data( SrcAll_FastFarm_DataData, DstAll_FastFarm 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' + CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopyMD_Data' ! ErrStat = ErrID_None ErrMsg = "" - CALL Farm_CopyParam( SrcAll_FastFarm_DataData%p, DstAll_FastFarm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL MD_CopyContState( SrcMD_DataData%x, DstMD_DataData%x, 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 MD_CopyDiscState( SrcMD_DataData%xd, DstMD_DataData%xd, 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) + 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 DstAll_FastFarm_DataData%FWrap.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%Input.', 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 ) + 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 ) + TYPE(MD_Data), INTENT(INOUT) :: MD_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyMD_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + CALL MD_DestroyContState( MD_DataData%x, ErrStat, ErrMsg ) + CALL MD_DestroyDiscState( MD_DataData%xd, ErrStat, ErrMsg ) + CALL MD_DestroyConstrState( MD_DataData%z, ErrStat, ErrMsg ) + CALL MD_DestroyOtherState( MD_DataData%OtherSt, ErrStat, ErrMsg ) + CALL MD_DestroyParam( MD_DataData%p, ErrStat, ErrMsg ) + CALL MD_DestroyInput( MD_DataData%u, ErrStat, ErrMsg ) +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), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MD_DataData%Input) +ENDIF +IF (ALLOCATED(MD_DataData%InputTimes)) THEN + DEALLOCATE(MD_DataData%InputTimes) +ENDIF + CALL MD_DestroyOutput( MD_DataData%y, ErrStat, ErrMsg ) + CALL MD_DestroyMisc( MD_DataData%m, ErrStat, ErrMsg ) + 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' +! + 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 @@ -4911,6 +6289,9 @@ SUBROUTINE Farm_CopyAll_FastFarm_Data( SrcAll_FastFarm_DataData, DstAll_FastFarm 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 ) @@ -4938,6 +6319,7 @@ SUBROUTINE Farm_DestroyAll_FastFarm_Data( All_FastFarm_DataData, ErrStat, ErrMsg ENDIF CALL Farm_Destroyawae_data( All_FastFarm_DataData%AWAE, ErrStat, ErrMsg ) CALL Farm_Destroysc_data( All_FastFarm_DataData%SC, ErrStat, ErrMsg ) + CALL Farm_Destroymd_data( All_FastFarm_DataData%MD, ErrStat, ErrMsg ) END SUBROUTINE Farm_DestroyAll_FastFarm_Data SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -5090,6 +6472,23 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt 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 @@ -5311,6 +6710,34 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt 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 ) @@ -5612,6 +7039,46 @@ SUBROUTINE Farm_UnPackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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 END MODULE FAST_Farm_Types diff --git a/glue-codes/openfast/CMakeLists.txt b/glue-codes/openfast/CMakeLists.txt index b6de649e29..5fe7c78227 100644 --- a/glue-codes/openfast/CMakeLists.txt +++ b/glue-codes/openfast/CMakeLists.txt @@ -27,11 +27,11 @@ add_executable(openfast_cpp src/FAST_Prog.cpp src/FastLibAPI.cpp) target_link_libraries(openfast_cpp openfastlib) string(TOUPPER ${CMAKE_Fortran_COMPILER_ID} _compiler_id) -string(TOUPPER ${CMAKE_BUILD_TYPE} _build_type) -if (${_compiler_id} STREQUAL "GNU" AND ${_build_type} STREQUAL "RELEASE") +if (${_compiler_id} STREQUAL "GNU" AND NOT ${VARIABLE_TRACKING}) # With variable tracking enabled, the compile step frequently aborts on large modules and - # restarts with this option off. Disabling in Release mode avoids this problem when compiling with - # full optimizations, but leaves it enabled for RelWithDebInfo which adds both -O2 and -g flags. + # restarts with this option off. Disabling avoids this problem when compiling with + # full optimizations. However, variable tracking should be enabled when actively debugging + # for better runtime debugging output. # https://gcc.gnu.org/onlinedocs/gcc/Debugging-Options.html set_source_files_properties(src/FAST_Prog.f90 PROPERTIES COMPILE_FLAGS "-fno-var-tracking -fno-var-tracking-assignments") endif() diff --git a/glue-codes/openfast/src/FastLibAPI.cpp b/glue-codes/openfast/src/FastLibAPI.cpp index 98c47ed647..12f58a7c7f 100644 --- a/glue-codes/openfast/src/FastLibAPI.cpp +++ b/glue-codes/openfast/src/FastLibAPI.cpp @@ -1,6 +1,7 @@ #include "FastLibAPI.h" #include +#include #include #include #include @@ -12,6 +13,7 @@ FastLibAPI::FastLibAPI(std::string input_file): n_turbines(1), i_turb(0), dt(0.0), +dt_out(0.0), t_max(0.0), abort_error_level(4), end_early(false), @@ -33,6 +35,7 @@ bool FastLibAPI::fatal_error(int error_status) { void FastLibAPI::fast_init() { int _error_status = 0; char _error_message[INTERFACE_STRING_LENGTH]; + char channel_names[MAXIMUM_OUTPUTS * CHANNEL_LENGTH + 1]; std::cout << input_file_name; @@ -51,6 +54,7 @@ void FastLibAPI::fast_init() { &abort_error_level, &num_outs, &dt, + &dt_out, &t_max, &_error_status, _error_message, @@ -61,16 +65,16 @@ void FastLibAPI::fast_init() { } // Allocate the data for the outputs - - // Create a dynamic array of pointers - // Then, create a row for every pointer and initialize all elements to 0.0 - output_values = new double *[total_time_steps()]; - for (int i=0; i(num_outs, 0)); + + // Get output channel names + std::istringstream ss(channel_names); + std::string channel_name; + output_channel_names.clear(); + while (ss >> channel_name) + { + output_channel_names.push_back(channel_name); } - - output_array.resize(num_outs); } void FastLibAPI::fast_sim() { @@ -82,28 +86,32 @@ void FastLibAPI::fast_sim() { &num_inputs, &num_outs, inp_array, - output_array.data(), + output_values[0].data(), &_error_status, _error_message ); - output_values[0] = output_array.data(); if (fatal_error(_error_status)) { fast_deinit(); throw std::runtime_error( "Error " + std::to_string(_error_status) + ": " + _error_message ); } + int output_frequency = round(dt_out/dt); + int i_out = 1; + for (int i=1; i output_array; - double **output_values; + std::vector> output_values; public: @@ -48,7 +46,8 @@ class FastLibAPI { void fast_deinit(); void fast_run(); int total_time_steps(); - std::string output_channel_names(); + int total_output_steps(); + std::vector output_channel_names; void get_hub_position(float *absolute_position, float *rotational_velocity, double *orientation_dcm); }; diff --git a/glue-codes/python/openfast_library.py b/glue-codes/python/openfast_library.py index 234e213612..b354b40419 100644 --- a/glue-codes/python/openfast_library.py +++ b/glue-codes/python/openfast_library.py @@ -32,11 +32,12 @@ def __init__(self, library_path: str, input_file_name: str): self.n_turbines = c_int(1) self.i_turb = c_int(0) self.dt = c_double(0.0) + self.dt_out = c_double(0.0) self.t_max = c_double(0.0) self.abort_error_level = c_int(4) # Initialize to 4 (ErrID_Fatal) and reset to user-given value in FAST_Sizes self.end_early = c_bool(False) self.num_outs = c_int(0) - self.channel_names = create_string_buffer(20 * 4000) + self.output_channel_names = [] self.ended = False # The inputs are meant to be from Simulink. @@ -48,9 +49,7 @@ def __init__(self, library_path: str, input_file_name: str): self.inp_array = (c_double * self.num_inputs.value)(0.0, ) # These arrays hold the outputs from OpenFAST - # output_array is a 1D array for the values from a single step - # output_values is a 2D array for the values from all steps in the simulation - self.output_array = None + # output_values is a 2D array for the values from all output steps in the simulation self.output_values = None @@ -68,6 +67,7 @@ def _initialize_routines(self) -> None: POINTER(c_int), # AbortErrLev_c OUT POINTER(c_int), # NumOuts_c OUT POINTER(c_double), # dt_c OUT + POINTER(c_double), # dt_out_c OUT POINTER(c_double), # tmax_c OUT POINTER(c_int), # ErrStat_c OUT POINTER(c_char), # ErrMsg_c OUT @@ -139,28 +139,38 @@ def fast_init(self) -> None: if self.fatal_error(_error_status): raise RuntimeError(f"Error {_error_status.value}: {_error_message.value}") + # Create channel names argument + channel_names = create_string_buffer(20 * 4000) + self.FAST_Sizes( byref(self.i_turb), self.input_file_name, byref(self.abort_error_level), byref(self.num_outs), byref(self.dt), + byref(self.dt_out), byref(self.t_max), byref(_error_status), _error_message, - self.channel_names, + channel_names, None, # Optional arguments must pass C-Null pointer; with ctypes, use None. None # Optional arguments must pass C-Null pointer; with ctypes, use None. ) if self.fatal_error(_error_status): raise RuntimeError(f"Error {_error_status.value}: {_error_message.value}") + # Extract channel name strings from argument + if len(channel_names.value.split()) == 0: + self.output_channel_names = [] + else: + self.output_channel_names = [n.decode('UTF-8') for n in channel_names.value.split()] + # Allocate the data for the outputs - # NOTE: The ctypes array allocation (output_array) must be after the output_values - # allocation, or otherwise seg fault. - self.output_values = np.empty( (self.total_time_steps, self.num_outs.value) ) - self.output_array = (c_double * self.num_outs.value)(0.0, ) + self.output_values = np.zeros( (self.total_output_steps, self.num_outs.value), dtype=c_double, order='C' ) + # Delete error message and channel name character buffers + del _error_message + del channel_names def fast_sim(self) -> None: _error_status = c_int(0) @@ -171,27 +181,31 @@ def fast_sim(self) -> None: byref(self.num_inputs), byref(self.num_outs), byref(self.inp_array), - byref(self.output_array), + self.output_values[0].ctypes.data_as(POINTER(c_double)), byref(_error_status), _error_message ) - self.output_values[0] = self.output_array[:] if self.fatal_error(_error_status): self.fast_deinit() raise RuntimeError(f"Error {_error_status.value}: {_error_message.value}") + # Calculate output frequency and initialize output index + output_frequency = round(self.dt_out.value/self.dt.value) + i_out = 1 + for i in range( 1, self.total_time_steps ): self.FAST_Update( byref(self.i_turb), byref(self.num_inputs), byref(self.num_outs), byref(self.inp_array), - byref(self.output_array), + self.output_values[i_out].ctypes.data_as(POINTER(c_double)), byref(self.end_early), byref(_error_status), _error_message ) - self.output_values[i] = self.output_array[:] + if i%output_frequency == 0: + i_out += 1 if self.fatal_error(_error_status): self.fast_deinit() raise RuntimeError(f"Error {_error_status.value}: {_error_message.value}") @@ -241,16 +255,14 @@ def total_time_steps(self) -> int: # and that's why we have the +1 below # # We assume here t_initial is always 0 - return math.ceil( self.t_max.value / self.dt.value) + 1 + return math.ceil( self.t_max.value / self.dt.value) + 1 @property - def output_channel_names(self) -> List: - if len(self.channel_names.value.split()) == 0: - return [] - output_channel_names = self.channel_names.value.split() - output_channel_names = [n.decode('UTF-8') for n in output_channel_names] - return output_channel_names + def total_output_steps(self) -> int: + # From FAST_Subs ValidateInputData: DT_out == DT or DT_out is a multiple of DT + # So the number of output steps can be calculated the same as the total time steps + return math.ceil(self.t_max.value / self.dt_out.value) + 1 def get_hub_position(self) -> Tuple: diff --git a/glue-codes/simulink/README.md b/glue-codes/simulink/README.md new file mode 100644 index 0000000000..a6509128b9 --- /dev/null +++ b/glue-codes/simulink/README.md @@ -0,0 +1,5 @@ +OpenFAST expects a set of channels passed from Simulink to the library. The number channels may change between OpenFAST releases. + +For list of control channels, see comments at end of source file modules/openfast-library/src/FAST_Library.h + +The examples included here inclue all the channels listed in the FAST_Library.h file. diff --git a/glue-codes/simulink/src/FAST_SFunc.c b/glue-codes/simulink/src/FAST_SFunc.c index b03d689a99..d18665a535 100644 --- a/glue-codes/simulink/src/FAST_SFunc.c +++ b/glue-codes/simulink/src/FAST_SFunc.c @@ -45,6 +45,7 @@ static double dt = 0; +static double dt_out = 0; static double TMax = 0; static int NumInputs = NumFixedInputs; static int NumAddInputs = 0; // number of additional inputs @@ -203,7 +204,7 @@ static void mdlInitializeSizes(SimStruct *S) FAST_AllocateTurbines(&nTurbines, &ErrStat, ErrMsg); if (checkError(S)) return; - FAST_Sizes(&iTurb, InputFileName, &AbortErrLev, &NumOutputs, &dt, &TMax, &ErrStat, ErrMsg, ChannelNames, &TMax, InitInputAry); + FAST_Sizes(&iTurb, InputFileName, &AbortErrLev, &NumOutputs, &dt, &dt_out, &TMax, &ErrStat, ErrMsg, ChannelNames, &TMax, InitInputAry); n_t_global = -1; if (checkError(S)) return; diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 index e463a8e34e..77449b40bc 100644 --- a/modules/aerodyn/src/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -1,6 +1,27 @@ !********************************************************************************************************************************** -! File last committed: 2020-02-12 +! LICENSING +! Copyright (C) 2015-2016 National Renewable Energy Laboratory +! Copyright (C) 2016-2017 Envision Energy USA, LTD +! +! 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. +! !********************************************************************************************************************************** +! +! References: +! [1] Brooks, T. F.; Pope, D. S. & Marcolini, M. A., Airfoil self-noise and prediction, +! NASA, NASA, 1989. https://ntrs.nasa.gov/search.jsp?R=19890016302 module AeroAcoustics use NWTC_Library @@ -44,7 +65,6 @@ subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None ! Local variables - integer(IntKi) :: i ! loop counter integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message type(AA_InputFile) :: InputFileData ! Data stored in the module's input file @@ -70,7 +90,7 @@ subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut p%RootName = TRIM(InitInp%RootName)//'.NN' ! Read the primary AeroAcoustics input file in AeroAcoustics_IO - call ReadInputFiles( InitInp%InputFile, InitInp%AFInfo%BL_file, InputFileData, interval, p%RootName, p%NumBlades, UnEcho, ErrStat2, ErrMsg2 ) + call ReadInputFiles( InitInp%InputFile, InitInp%AFInfo, InputFileData, interval, p%RootName, UnEcho, ErrStat2, ErrMsg2 ) if (Failed()) return ! Validate the inputs @@ -85,7 +105,7 @@ subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Define parameters call SetParameters( InitInp, InputFileData, p, ErrStat2, ErrMsg2 ); if(Failed()) return ! Define and initialize inputs - call Init_u( u, p, InputFileData, InitInp, errStat2, errMsg2 ); if(Failed()) return + call Init_u( u, p, errStat2, errMsg2 ); if(Failed()) return ! Define outputs here call Init_y(y, u, p, errStat2, errMsg2); if(Failed()) return @@ -95,7 +115,7 @@ subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut call Init_States(xd, p, errStat2, errMsg2); if(Failed()) return ! Define initialization output here - call AA_SetInitOut(p, InputFileData, InitOut, errStat2, errMsg2); if(Failed()) return + call AA_SetInitOut(p, InitOut, errStat2, errMsg2); if(Failed()) return call AA_InitializeOutputFile(p, InputFileData,InitOut,errStat2, errMsg2); if(Failed()) return call Cleanup() @@ -122,10 +142,10 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) ! Local variables CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat / = ErrID_None INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - INTEGER(IntKi) :: simcou,coun ! simple loop counter +! INTEGER(IntKi) :: simcou,coun ! simple loop counter INTEGER(IntKi) :: I,J,whichairfoil,K,i1_1,i10_1,i1_2,i10_2,iLE character(*), parameter :: RoutineName = 'SetParameters' - LOGICAL :: tr,tri,exist,LE_flag + LOGICAL :: tri,LE_flag REAL(ReKi) :: val1,val10,f2,f4,lefttip,rightip,jumpreg, dist1, dist10 ! Initialize variables for this routine ErrStat = ErrID_None @@ -188,8 +208,8 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) DO k=1,size(p%AFInfo) ! if any of the airfoil coordinates are missing change calculation method IF( (size(p%AFInfo(k)%X_Coord) .lt. 5) .or. (size(p%AFInfo(k)%Y_Coord).lt.5) )then IF (tri) then ! Print the message for once only - print*, 'Airfoil coordinates are missing: If Full or Simplified Guidati or Bl Calculation is on coordinates are needed ' - print*, 'Calculation methods enforced as BPM for TBLTE and only Amiet for inflow ' + CALL WrScr( 'Airfoil coordinates are missing: If Full or Simplified Guidati or Bl Calculation is on coordinates are needed ' ) + CALL WrScr( 'Calculation methods enforced as BPM for TBLTE and only Amiet for inflow ' ) p%ITURB = 1 p%IInflow = 1 tri=.false. @@ -201,7 +221,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) ! Check 2 ! if passed the first check and if tno, turn on boundary layer calculation IF( (p%ITURB.eq.2)) then - p%X_BLMethod=2 + p%X_BLMethod=X_BLMethod_Tables ENDIF ! Check 3 @@ -306,7 +326,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) ENDDO ENDDO - if (p%X_BLMethod.eq.2) then + if (p%X_BLMethod .eq. X_BLMethod_Tables) then ! Copying inputdata list of AOA and Reynolds to parameters call AllocAry( p%AOAListBL, size(InputFileData%AOAListBL), 'p%AOAListBL', errStat2, errMsg2); if(Failed()) return @@ -440,11 +460,9 @@ end function Failed end subroutine SetParameters !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes AeroAcoustics module input array variables for use during the simulation. -subroutine Init_u( u, p, InputFileData, InitInp, errStat, errMsg ) +subroutine Init_u( u, p, errStat, errMsg ) type(AA_InputType), intent( out) :: u !< Input data type(AA_ParameterType), intent(in ) :: p !< Parameters - type(AA_InputFile), intent(in ) :: InputFileData !< Data stored in the module's input file - type(AA_InitInputType), intent(in ) :: InitInp !< Input data for AD initialization routine integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None !local variables @@ -477,7 +495,6 @@ subroutine Init_y(y, u, 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 - integer(intKi) :: k ! loop counter for blades integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'Init_y' @@ -530,7 +547,6 @@ subroutine Init_MiscVars(m, p, u, y, 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) :: k integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'Init_MiscVars' @@ -652,13 +668,12 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, 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 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message +! integer(intKi) :: ErrStat2 ! temporary Error status +! character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'AA_UpdateStates' REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) :: TEMPSTD ! temporary standard deviation variable REAL(ReKi) :: tempsingle,tempmean,angletemp,abs_le_x,ti_vx,U1,U2 ! temporary standard deviation variable integer(intKi) :: i,j,k,rco, y0_a,y1_a,z0_a,z1_a - logical :: exist REAL(ReKi) :: yi_a,zi_a,yd_a,zd_a,c00_a,c10_a ErrStat = ErrID_None @@ -684,7 +699,7 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) ELSEIF ((abs_le_x.gt.0).and.(m%LE_Location(2,j,i).gt.0)) THEN angletemp=ATAN( m%LE_Location(2,j,i)/abs_le_x ) * R2D_D ELSE - print*, 'problem in angletemp Aeroacoustics module' + CALL WrScr( 'problem in angletemp Aeroacoustics module' ) ENDIF !abs_le_x=ABS(abs_le_x) do k=1,size(p%rotorregionlimitsrad) @@ -733,7 +748,7 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) 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.) + 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 @@ -799,7 +814,6 @@ subroutine AA_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg) CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: i integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CalcOutput' @@ -846,10 +860,9 @@ SUBROUTINE CalcObserve(t,p,m,u,xd,errStat,errMsg) INTEGER(intKi) :: I ! I A generic index for DO loops. INTEGER(intKi) :: J ! J A generic index for DO loops. INTEGER(intKi) :: K ! K A generic index for DO loops. - INTEGER(intKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 +! INTEGER(intKi) :: ErrStat2 +! CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), parameter :: RoutineName = 'CalcObserveDist' - LOGICAL :: exist ErrStat = ErrID_None ErrMsg = "" @@ -932,16 +945,16 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) integer(intKi) :: III !III A generic index for DO loops. integer(intKi) :: I !I A generic index for DO loops. integer(intKi) :: J !J A generic index for DO loops. - integer(intKi) :: K,liop,cou ,JTEMP !K A generic index for DO loops. + integer(intKi) :: K !,liop,cou ,JTEMP !K A generic index for DO loops. integer(intKi) :: oi !K A generic index for DO loops. REAL(ReKi) :: AlphaNoise ! REAL(ReKi) :: UNoise ! REAL(ReKi) :: elementspan ! - REAL(ReKi),DIMENSION(p%NumBlNds) ::tempdel - REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades) ::OASPLTBLAll +! REAL(ReKi),DIMENSION(p%NumBlNds) ::tempdel +! REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades) ::OASPLTBLAll REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades,size(p%FreqList)) ::ForMaxLoc REAL(ReKi),DIMENSION(size(y%OASPL_Mech,1),size(p%FreqList),p%NrObsLoc,p%NumBlNds,p%numBlades) :: ForMaxLoc3 - REAL(ReKi),DIMENSION(size(p%FreqList),p%NrObsLoc,p%numBlades) ::SPL_Out +! REAL(ReKi),DIMENSION(size(p%FreqList),p%NrObsLoc,p%numBlades) ::SPL_Out REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) ::temp_dispthick REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) ::temp_dispthickchord @@ -960,16 +973,15 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) real(ReKi) :: PTBLALH real(ReKi) :: PTip real(ReKi) :: PTI - real(ReKi) :: PBLNT,adforma - REAL(ReKi),DIMENSION(2) :: Cf ,d99, d_star - TYPE(FFT_DataType) :: FFT_Data !< the instance of the FFT module we're using - REAL(ReKi),DIMENSION(p%total_sample) :: spect_signal - REAL(ReKi),DIMENSION(p%total_sample/2) :: spectra - real(ReKi),ALLOCATABLE :: fft_freq(:) + real(ReKi) :: PBLNT !,adforma +! REAL(ReKi),DIMENSION(2) :: Cf ,d99, d_star +! TYPE(FFT_DataType) :: FFT_Data !< the instance of the FFT module we're using +! REAL(ReKi),DIMENSION(p%total_sample) :: spect_signal +! REAL(ReKi),DIMENSION(p%total_sample/2) :: spectra +! real(ReKi),ALLOCATABLE :: fft_freq(:) integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'CalcAeroAcousticsOutput' - logical :: exist ErrStat = ErrID_None ErrMsg = "" @@ -1056,7 +1068,7 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) !--------Read in Boundary Layer Data-------------------------! - IF (p%X_BLMethod .EQ. 2) THEN + IF (p%X_BLMethod .EQ. X_BLMethod_Tables) THEN call BL_Param_Interp(p,m,Unoise,AlphaNoise,p%BlChord(J,I),p%BlAFID(J,I), errStat2, errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) temp_dispthick(J,I) = m%d99Var(1) @@ -1079,13 +1091,13 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) !--------Turbulent Boundary Layer Trailing Edge Noise----------------------------! IF ( (p%ITURB .EQ. 1) .or. (p%ITURB .EQ. 2) ) THEN CALL TBLTE(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I), p, j,i,k,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I), & + elementspan,m%rTEtoObserve(K,J,I), p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I), & m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2,errMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (p%ITURB .EQ. 2) THEN m%SPLP=0.0_ReKi;m%SPLS=0.0_ReKi;m%SPLTBL=0.0_ReKi; m%EdgeVelVar(1)=1.000d0;m%EdgeVelVar(2)=m%EdgeVelVar(1); - CALL TBLTE_TNO(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + CALL TBLTE_TNO(UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & elementspan,m%rTEtoObserve(K,J,I),m%CfVar,m%d99var,m%EdgeVelVar ,p, & m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2 ,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -1110,7 +1122,7 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) ! Amiet's Inflow Noise Model is Calculated as long as InflowNoise is On CALL InflowNoise(AlphaNoise,p%BlChord(J,I),Unoise,m%ChordAngleLE(K,J,I),m%SpanAngleLE(K,J,I),& - elementspan,m%rLEtoObserve(K,J,I),xd%MeanVxVyVz(J,I),xd%TIVx(J,I),m%LE_Location(3,J,I),0.050,p,m%SPLti,errStat2,errMsg2 ) + elementspan,m%rLEtoObserve(K,J,I),xd%TIVx(J,I),p,m%SPLti,errStat2,errMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! If Guidati model (simplified or full version) is also on then the 'SPL correction' to Amiet's model will be added IF ( p%IInflow .EQ. 2 ) THEN @@ -1119,7 +1131,7 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) m%SPLti=m%SPLti+m%SPLTIGui + 10. ! +10 is fudge factor to match NLR data ELSEIF ( p%IInflow .EQ. 3 ) THEN - print*,'Full Guidati removed' + CALL WrScr('Full Guidati removed') STOP ENDIF ENDIF @@ -1324,12 +1336,12 @@ SUBROUTINE LBLVS(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,SPLLAM, M = U / p%SpdSound ! MACH NUMBER RC = U * C/p%KinVisc ! REYNOLDS NUMBER BASED ON CHORD ! compute boundary layer thicknesses - IF (p%X_BLMethod .eq. 2) THEN + IF (p%X_BLMethod .eq. X_BLMethod_Tables) THEN DELTAP = d99Var2 DSTRS = dstarVar1 DSTRP = dstarVar2 ELSE - CALL THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) + CALL THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF ! compute directivity function @@ -1353,7 +1365,7 @@ SUBROUTINE LBLVS(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,SPLLAM, D = RC / RC0 ! Used in Eq 58 from BPM Airfoil Self-noise and Prediction paper IF (D .LE. .3237) G2 =77.852*LOG10(D)+15.328 ! Begin Eq 58 from BPM Airfoil Self-noise and Prediction paper IF ((D .GT. .3237).AND.(D .LE. .5689)) G2 = 65.188*LOG10(D) + 9.125 - IF ((D .GT. .5689).AND.(D .LE. 1.7579)) G2 = -114.052 * LOG10(D)**2. + IF ((D .GT. .5689).AND.(D .LE. 1.7579)) G2 = -114.052 * LOG10(D)**2 IF ((D .GT. 1.7579).AND.(D .LE. 3.0889)) G2 = -65.188*LOG10(D)+9.125 IF (D .GT. 3.0889) G2 =-77.852*LOG10(D)+15.328 ! end ! compute angle-dependent level for shape curve @@ -1365,14 +1377,14 @@ SUBROUTINE LBLVS(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,SPLLAM, E = STPRIM / STPKPRM ! Used in Eq 57 from BPM Airfoil Self-noise and Prediction paper IF (E .LE. .5974) G1 = 39.8*LOG10(E)-11.12 ! Begin Eq 57 from BPM Airfoil Self-noise and Prediction paper IF ((E .GT. .5974).AND.(E .LE. .8545)) G1 = 98.409 * LOG10(E) + 2.0 - IF ((E .GT. .8545).AND.(E .LE. 1.17)) G1 = -5.076+SQRT(2.484-506.25*(LOG10(E))**2.) + IF ((E .GT. .8545).AND.(E .LE. 1.17)) G1 = -5.076+SQRT(2.484-506.25*(LOG10(E))**2) IF ((E .GT. 1.17).AND.(E .LE. 1.674)) G1 = -98.409 * LOG10(E) + 2.0 IF (E .GT. 1.674) G1 = -39.80*LOG10(E)-11.12 ! end SPLLAM(I) = G1 + G2 + G3 + SCALE ! Eq 53 from BPM Airfoil Self-noise and Prediction paper ENDDO END SUBROUTINE LBLVS !==================================================================================================================================! -SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar2,StallVal,SPLP,SPLS,SPLALPH,SPLTBL,errStat,errMsg) +SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,StallVal,SPLP,SPLS,SPLALPH,SPLTBL,errStat,errMsg) REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA(deg) REAL(ReKi), INTENT(IN ) :: C ! Chord Length (m) ! REAL(ReKi), INTENT(IN ) :: U ! Unoise(m/s) @@ -1393,10 +1405,7 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar REAL(ReKi), INTENT(IN ) :: dstarVar1 ! REAL(ReKi), INTENT(IN ) :: dstarVar2 ! REAL(ReKi), INTENT(IN ) :: StallVal ! - INTEGER(IntKi), INTENT( IN) :: jj ! Error status of the operation - INTEGER(IntKi), INTENT( IN) :: ii ! Error status of the operation - INTEGER(IntKi), INTENT( IN) :: kk ! Error status of the operation TYPE(AA_ParameterType), INTENT(IN ) :: p ! Noise Module Parameters REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLP ! SOUND PRESSURE LEVEL DUE TO PRESSURE SIDE OF AIRFOIL (db) REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLS ! SOUND PRESSURE LEVEL DUE TO SUCTION SIDE OF AIRFOIL (db) @@ -1469,12 +1478,12 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar M = U / p%SpdSound RC = U * C/p%KinVisc ! Compute boundary layer thicknesses - IF (p%X_BLMethod .eq. 2) THEN + IF (p%X_BLMethod .eq. X_BLMethod_Tables) THEN DELTAP = d99Var2 DSTRS = dstarVar1 DSTRP = dstarVar2 ELSE - CALL THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) + CALL THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF ! Compute directivity function @@ -1495,7 +1504,7 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar ST1 = .02 * M ** (-.6) ! Eq 32 from BPM Airfoil Self-noise and Prediction paper ! Eq 34 from BPM Airfoil Self-noise and Prediction paper IF (ALPSTAR .LE. 1.333) ST2 = ST1 - IF ((ALPSTAR .GT. 1.333).AND.(ALPSTAR .LE. StallVal)) ST2 = ST1*10.**(.0054*(ALPSTAR-1.333)**2.) + IF ((ALPSTAR .GT. 1.333).AND.(ALPSTAR .LE. StallVal)) ST2 = ST1*10.**(.0054*(ALPSTAR-1.333)**2) 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) @@ -1511,7 +1520,7 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar ! Compute b0 to be used in 'b' curve calculations ! Eq 44 from BPM Airfoil Self-noise and Prediction paper IF (RC .LT. 9.52E+04) B0 = .30 IF ((RC .GE. 9.52E+04).AND.(RC .LT. 8.57E+05)) & - B0 = (-4.48E-13)*(RC-8.57E+05)**2. + .56 + B0 = (-4.48E-13)*(RC-8.57E+05)**2 + .56 IF (RC .GE. 8.57E+05) B0 = .56 ! Evaluate minimum and maximum 'b' curves at b0 CALL BMIN(B0,BMINB0) @@ -1534,7 +1543,7 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar IF (ALPSTAR .LE. (GAMMA0-GAMMA)) K2 = -1000.0 ! Begin Eq 49 from BPM Airfoil Self-noise and Prediction paper IF ((ALPSTAR.GT.(GAMMA0-GAMMA)).AND.(ALPSTAR.LE.(GAMMA0+GAMMA))) & - K2=SQRT(BETA**2.-(BETA/GAMMA)**2.*(ALPSTAR-GAMMA0)**2.)+BETA0 + K2=SQRT(BETA**2-(BETA/GAMMA)**2*(ALPSTAR-GAMMA0)**2)+BETA0 IF (ALPSTAR .GT. (GAMMA0+GAMMA)) K2 = -12.0 K2 = K2 + K1 ! end ! Check for 'a' computation for suction side @@ -1551,7 +1560,7 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar CALL AMAX(A,AMAXA) AA = AMINA + ARA0 * (AMAXA - AMINA) ! Eq 40 from BPM Airfoil Self-noise and Prediction paper - SPLP(I)=AA+K1-3.+10.*LOG10(DSTRP*M**5.*DBARH*L/R**2.)+DELK1 ! Eq 25 from BPM Airfoil Self-noise and Prediction paper + SPLP(I)=AA+K1-3.+10.*LOG10(DSTRP*M**5*DBARH*L/R**2)+DELK1 ! Eq 25 from BPM Airfoil Self-noise and Prediction paper STS = p%FreqList(I) * DSTRS / U ! Eq 31 from BPM Airfoil Self-noise and Prediction paper IF (.NOT. SWITCH) THEN @@ -1559,25 +1568,25 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar CALL AMIN(A,AMINA) CALL AMAX(A,AMAXA) AA = AMINA + ARA0 * (AMAXA - AMINA) - SPLS(I) = AA+K1-3.+10.*LOG10(DSTRS*M**5.*DBARH* L/R**2.) ! Eq 26 from BPM Airfoil Self-noise and Prediction paper + SPLS(I) = AA+K1-3.+10.*LOG10(DSTRS*M**5*DBARH* L/R**2) ! Eq 26 from BPM Airfoil Self-noise and Prediction paper ! 'B' CURVE COMPUTATION ! B = ABS(LOG10(STS / ST2)) B = LOG10(STS / ST2) ! abs not needed absolute taken in the AMAX,AMIN ! Eq 43 from BPM Airfoil Self-noise and Prediction paper CALL BMIN(B,BMINB) CALL BMAX(B,BMAXB) BB = BMINB + BRB0 * (BMAXB-BMINB) ! Eq 46 from BPM Airfoil Self-noise and Prediction paper - SPLALPH(I)=BB+K2+10.*LOG10(DSTRS*M**5.*DBARH*L/R**2.) ! Eq 27 from BPM Airfoil Self-noise and Prediction paper + SPLALPH(I)=BB+K2+10.*LOG10(DSTRS*M**5*DBARH*L/R**2) ! Eq 27 from BPM Airfoil Self-noise and Prediction paper ELSE ! The 'a' computation is dropped if 'switch' is true - SPLS(I) = 10.*LOG10(DSTRS*M**5.*DBARL*L/R**2.) - ! SPLP(I) = 0.0 + 10.*LOG10(DSTRS*M**5.*DBARL*L/R**2.) ! changed the line below because the SPLP should be calculatd with DSTRP not with DSTRS - SPLP(I) = 10.*LOG10(DSTRP*M**5.*DBARL*L/R**2.) ! this is correct + SPLS(I) = 10.*LOG10(DSTRS*M**5*DBARL*L/R**2) + ! SPLP(I) = 0.0 + 10.*LOG10(DSTRS*M**5*DBARL*L/R**2) ! changed the line below because the SPLP should be calculatd with DSTRP not with DSTRS + SPLP(I) = 10.*LOG10(DSTRP*M**5*DBARL*L/R**2) ! this is correct ! B = ABS(LOG10(STS / ST2)) B = LOG10(STS / ST2) ! abs not needed absolute taken in the AMAX,AMIN CALL AMIN(B,AMINB) CALL AMAX(B,AMAXB) BB = AMINB + ARA02 * (AMAXB-AMINB) - SPLALPH(I)=BB+K2+10.*LOG10(DSTRS*M**5.*DBARL*L/R**2.) + SPLALPH(I)=BB+K2+10.*LOG10(DSTRS*M**5*DBARL*L/R**2) ENDIF ! Sum all contributions from 'a' and 'b' on both pressure and suction side on a mean-square pressure basis IF (SPLP(I) .LT. -100.) SPLP(I) = -100. ! Similar to Eq 28 of BPM Airfoil Self-noise and Prediction paper @@ -1647,7 +1656,7 @@ SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) ENDIF MM = (1. + .036*ALPTIPP) * M ! Eq 64 from BPM Airfoil Self-noise and Prediction paper UM = MM * p%SpdSound ! Eq 65 from BPM Airfoil Self-noise and Prediction paper - TERM = M*M*MM**3.*L**2.*DBARH/R**2. ! TERM = M^2 * M_max^5 *l^2 *D / r^2 according to Semi-Empirical Aeroacoustic Noise Prediction Code for Wind Turbines paper + TERM = M*M*MM**3*L**2*DBARH/R**2 ! TERM = M^2 * M_max^5 *l^2 *D / r^2 according to Semi-Empirical Aeroacoustic Noise Prediction Code for Wind Turbines paper ! Term is correct according to Eq 61 from BPM Airfoil self-noise and Prediction paper IF (TERM .NE. 0.0) THEN SCALE = 10.*LOG10(TERM) @@ -1656,34 +1665,23 @@ SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) ENDIF DO I=1,size(p%FreqList) STPP = p%FreqList(I) * L / UM ! Eq 62 from BPM Airfoil Self-noise and Prediction paper - SPLTIP(I) = 126.-30.5*(LOG10(STPP)+.3)**2. + SCALE ! Eq 61 from BPM Airfoil Self-noise and Prediction paper + SPLTIP(I) = 126.-30.5*(LOG10(STPP)+.3)**2 + SCALE ! Eq 61 from BPM Airfoil Self-noise and Prediction paper ENDDO END SUBROUTINE TipNois !==================================================================================================================================! -SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE_Location,dissip,p,SPLti,errStat,errMsg) -! REAL(ReKi), INTENT(IN ) :: AlphaNoise ! AOA -! REAL(ReKi), INTENT(IN ) :: Chord ! Chord Length -! REAL(ReKi), INTENT(IN ) :: U ! -! REAL(ReKi), INTENT(IN ) :: d ! element span -! REAL(ReKi), INTENT(IN ) :: RObs ! distance to observer -! REAL(ReKi), INTENT(IN ) :: THETA ! -! REAL(ReKi), INTENT(IN ) :: PHI ! Spanwise directivity angle +SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti,errStat,errMsg) + REAL(ReKi), INTENT(IN ) :: AlphaNoise ! AOA + REAL(ReKi), INTENT(IN ) :: Chord ! Chord Length + REAL(ReKi), INTENT(IN ) :: U ! + REAL(ReKi), INTENT(IN ) :: THETA ! + REAL(ReKi), INTENT(IN ) :: PHI ! Spanwise directivity angle + REAL(ReKi), INTENT(IN ) :: d ! element span + REAL(ReKi), INTENT(IN ) :: RObs ! distance to observer ! REAL(ReKi), INTENT(IN ) :: MeanVNoise ! -! REAL(ReKi), INTENT(IN ) :: TINoise ! + REAL(ReKi), INTENT(IN ) :: TINoise ! ! REAL(ReKi), INTENT(IN ) :: LE_Location ! - - REAL(ReKi) :: AlphaNoise ! AOA - REAL(ReKi) :: Chord ! Chord Length - REAL(ReKi) :: U ! - REAL(ReKi) :: d ! element span - REAL(ReKi) :: RObs ! distance to observer - REAL(ReKi) :: THETA ! - REAL(ReKi) :: PHI ! Spanwise directivity angle - REAL(ReKi) :: MeanVNoise ! - REAL(ReKi) :: TINoise ! - REAL(ReKi) :: LE_Location ! - - REAL(ReKi), INTENT(IN ) :: dissip ! + +! REAL(ReKi), INTENT(IN ) :: dissip ! TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti ! INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation @@ -1701,13 +1699,14 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE REAL(ReKi) :: Mach ! local mach number REAL(ReKi) :: Sears ! Sears function REAL(ReKi) :: SPLhigh ! predicted high frequency sound pressure level - REAL(ReKi) :: Ums ! mean square turbulence level +! REAL(ReKi) :: Ums ! mean square turbulence level REAL(ReKi) :: WaveNumber ! wave number - non-dimensional frequency REAL(ReKi) :: Kbar ! nafnoise - REAL(ReKi) :: khat,Kh ! nafnoise + REAL(ReKi) :: khat ! nafnoise +! REAL(ReKi) :: Kh ! nafnoise REAL(ReKi) :: ke ! nafnoise REAL(ReKi) :: alpstar ! nafnoise - REAL(ReKi) :: mu ! nafnoise +! REAL(ReKi) :: mu ! nafnoise REAL(ReKi) :: tinooisess ! nafnoise ! REAL(ReKi) :: L_Gammas ! nafnoise @@ -1957,7 +1956,6 @@ SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2, ! real(ReKi) :: G5 ! SPECTRUM SHAPE FUNCTION DB REAL(ReKi),DIMENSION(size(p%FreqList)) :: G5 ! SPECTRUM SHAPE FUNCTION DB ! corrected (EB_DTU) real(ReKi) :: G5Sum ! SPECTRUM SHAPE FUNCTION DB - real(ReKi) :: F4TEMP ! G5 EVALUATED AT MINIMUM HDSTARP DB real(ReKi) :: SCALE ! SCALING FACTOR --- ErrStat = ErrID_None @@ -1967,12 +1965,12 @@ SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2, M = U / p%SpdSound RC = U * C/p%KinVisc ! Compute boundary layer thicknesses - IF (p%X_BLMethod .eq. 2) THEN + IF (p%X_BLMethod .eq. X_BLMethod_Tables) THEN DELTAP = d99Var2 DSTRS = dstarVar1 DSTRP = dstarVar2 ELSE - CALL THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) + CALL THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF ! Compute average displacement thickness @@ -1989,7 +1987,7 @@ SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2, ! Compute peak strouhal number eq 72 in BPM Airfoil Self-noise and Prediction paper ATERM = .212 - .0045 * PSI IF (HDSTAR .GE. .2) & - STPEAK = ATERM / (1.+.235*DSTARH-.0132*DSTARH**2.) ! this is what it used to be in nafnoise and fast noise module + STPEAK = ATERM / (1.+.235*DSTARH-.0132*DSTARH**2) ! this is what it used to be in nafnoise and fast noise module !! STPEAK = ATERM / (1+0.235*(DSTARH)**(-1)-0.0132*DSTARH**(-2)) ! check if this one is correct (EB_DTU) IF (HDSTAR .LT. .2) & STPEAK = .1 * HDSTAR + .095 - .00243 * PSI @@ -1997,7 +1995,7 @@ SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2, IF (HDSTAR .LE. 5.) G4=17.5*LOG10(HDSTAR)+157.5-1.114*PSI IF (HDSTAR .GT. 5.) G4=169.7 - 1.114 * PSI ! For each frequency, compute spectrum shape referenced to 0 db - SCALE = 10. * LOG10(M**5.5*H*DBARH*L/R**2.) + SCALE = 10. * LOG10(M**5.5*H*DBARH*L/R**2) G5Sum=0.0_Reki DO I=1,SIZE(p%FreqList) STPPP = p%FreqList(I) * H / U @@ -2005,7 +2003,7 @@ SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2, HDSTARL = HDSTAR CALL G5COMP(HDSTARL,ETA,G514,errStat2,errMsg2 ) ! compute G5 for Phi=14deg CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - HDSTARP = 6.724 * HDSTAR **2.-4.019*HDSTAR+1.107 ! eq 82 from BPM Airfoil Self-noise and Prediction paper + HDSTARP = 6.724 * HDSTAR **2-4.019*HDSTAR+1.107 ! eq 82 from BPM Airfoil Self-noise and Prediction paper CALL G5COMP(HDSTARP,ETA,G50,errStat2,errMsg2 ) ! recompute G5 for Phi=0deg CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) G5(I) = G50 + .0714 * PSI * (G514-G50) ! interpolate G5 from G50 and G514 @@ -2022,8 +2020,8 @@ SUBROUTINE G5COMP(HDSTAR,ETA,G5,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 ! temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message +! INTEGER(intKi) :: ErrStat2 ! temporary Error status +! CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message CHARACTER(*), parameter :: RoutineName = 'BLUNT' real(ReKi) :: K real(ReKi) :: M @@ -2044,11 +2042,11 @@ SUBROUTINE G5COMP(HDSTAR,ETA,G5,errStat,errMsg) IF ( HDSTAR .GT. 1.2 ) M = 268.344 IF ( M .LT. 0.0 ) M = 0.0 ! end ETA0 = -SQRT((M*M*MU**4)/(6.25+M*M*MU*MU)) ! eq 80 from BPM Airfoil Self-noise and Prediction paper - K = 2.5*SQRT(1.-(ETA0/MU)**2.)-2.5-M*ETA0 ! eq 81 from BPM Airfoil Self-noise and Prediction paper + K = 2.5*SQRT(1.-(ETA0/MU)**2)-2.5-M*ETA0 ! eq 81 from BPM Airfoil Self-noise and Prediction paper ETALIMIT = 0.03615995 ! one of the bounds given in eq 76 of BPM Airfoil Self-noise and Prediction paper IF (ETA .LE. ETA0) G5 = M * ETA + K ! begin eq 76 from BPM Airfoil Self-noise and Prediction paper - IF((ETA.GT.ETA0).AND.(ETA .LE. 0.)) G5 = 2.5*SQRT(1.-(ETA/MU)**2.)-2.5 - IF((ETA.GT.0. ).AND.(ETA.LE.ETALIMIT)) G5 = SQRT(1.5625-1194.99*ETA**2.)-1.25 + IF((ETA.GT.ETA0).AND.(ETA .LE. 0.)) G5 = 2.5*SQRT(1.-(ETA/MU)**2)-2.5 + IF((ETA.GT.0. ).AND.(ETA.LE.ETALIMIT)) G5 = SQRT(1.5625-1194.99*ETA**2)-1.25 IF (ETA.GT.ETALIMIT) G5 = -155.543 * ETA + 4.375 ! end END SUBROUTINE G5Comp !==================================================================================================== @@ -2058,9 +2056,9 @@ SUBROUTINE AMIN(A,AMINA) REAL(ReKi), INTENT(OUT ) :: AMINA REAL(ReKi) :: X1 X1 = ABS(A) - IF (X1 .LE. .204) AMINA=SQRT(67.552-886.788*X1**2.)-8.219 + IF (X1 .LE. .204) AMINA=SQRT(67.552-886.788*X1**2)-8.219 IF((X1 .GT. .204).AND.(X1 .LE. .244))AMINA=-32.665*X1+3.981 - IF (X1 .GT. .244)AMINA=-142.795*X1**3.+103.656*X1**2.-57.757*X1+6.006 + IF (X1 .GT. .244)AMINA=-142.795*X1**3+103.656*X1**2-57.757*X1+6.006 END SUBROUTINE AMIN !==================================================================================================== !> This subroutine defines the curve fit corresponding to the a-curve for the maximum allowed reynolds number. @@ -2069,9 +2067,9 @@ SUBROUTINE AMAX(A,AMAXA) REAL(ReKi), INTENT(OUT ) :: AMAXA REAL(ReKi) :: X1 X1 = ABS(A) - IF (X1 .LE. .13)AMAXA=SQRT(67.552-886.788*X1**2.)-8.219 + IF (X1 .LE. .13)AMAXA=SQRT(67.552-886.788*X1**2)-8.219 IF((X1 .GT. .13).AND.(X1 .LE. .321))AMAXA=-15.901*X1+1.098 - IF (X1 .GT. .321)AMAXA=-4.669*X1**3.+3.491*X1**2.-16.699*X1+1.149 + IF (X1 .GT. .321)AMAXA=-4.669*X1**3+3.491*X1**2-16.699*X1+1.149 END SUBROUTINE AMAX !==================================================================================================== !> This subroutine defines the curve fit corresponding to the b-curve for the minimum allowed reynolds number. @@ -2080,9 +2078,9 @@ SUBROUTINE BMIN(B,BMINB) REAL(ReKi), INTENT(OUT ) :: BMINB REAL(ReKi) :: X1 X1 = ABS(B) - IF (X1 .LE. .13)BMINB=SQRT(16.888-886.788*X1**2.)-4.109 + IF (X1 .LE. .13)BMINB=SQRT(16.888-886.788*X1**2)-4.109 IF((X1 .GT. .13).AND.(X1 .LE. .145))BMINB=-83.607*X1+8.138 - IF (X1.GT..145)BMINB=-817.81*X1**3.+355.21*X1**2.-135.024*X1+10.619 + IF (X1.GT..145)BMINB=-817.81*X1**3+355.21*X1**2-135.024*X1+10.619 END SUBROUTINE BMin !==================================================================================================== !> Define the curve fit corresponding to the b-curve for the maximum allowed reynolds number. @@ -2091,9 +2089,9 @@ SUBROUTINE BMAX(B,BMAXB) REAL(ReKi), INTENT(OUT ) :: BMAXB REAL(ReKi) :: X1 X1 = ABS(B) - IF (X1 .LE. .1) BMAXB=SQRT(16.888-886.788*X1**2.)-4.109 + IF (X1 .LE. .1) BMAXB=SQRT(16.888-886.788*X1**2)-4.109 IF((X1 .GT. .1).AND.(X1 .LE. .187))BMAXB=-31.313*X1+1.854 - IF (X1.GT..187)BMAXB=-80.541*X1**3.+44.174*X1**2.-39.381*X1+2.344 + IF (X1.GT..187)BMAXB=-80.541*X1**3+44.174*X1**2-39.381*X1+2.344 END SUBROUTINE BMax !==================================================================================================== !> Determine where the a-curve takes on a value of -20 db. @@ -2102,12 +2100,12 @@ SUBROUTINE A0COMP(RC,A0) REAL(ReKi), INTENT(OUT ) :: A0 IF (RC .LT. 9.52E+04) A0 = .57 IF ((RC .GE. 9.52E+04).AND.(RC .LT. 8.57E+05)) & - A0 = (-9.57E-13)*(RC-8.57E+05)**2. + 1.13 + A0 = (-9.57E-13)*(RC-8.57E+05)**2 + 1.13 IF (RC .GE. 8.57E+05) A0 = 1.13 END SUBROUTINE A0COMP !==================================================================================================== !> Compute zero angle of attack boundary layer thickness (meters) and reynolds number -SUBROUTINE THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat,errMsg) +SUBROUTINE THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat,errMsg) !! VARIABLE NAME DEFINITION UNITS !! ------------- ---------- ----- !! ALPSTAR ANGLE OF ATTACK DEGREES @@ -2124,14 +2122,12 @@ SUBROUTINE THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat,errMsg) !! DSTRS SUCTION SIDE DISPLACEMENT !! THICKNESS METERS !! ITRIP TRIGGER FOR BOUNDARY LAYER TRIPPING --- -!! M MACH NUMBER --- !! RC REYNOLDS NUMBER BASED ON CHORD --- !! U FREESTREAM VELOCITY METERS/SEC !! KinViscosity KINEMATIC VISCOSITY M2/SEC REAL(ReKi), INTENT(IN ) :: ALPSTAR !< AOA REAL(ReKi), INTENT(IN ) :: C !< Chord Length REAL(ReKi), INTENT(IN ) :: RC !< RC= U*C/KinViscosity - REAL(ReKi), INTENT(IN ) :: M !< M = U/C0 TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters REAL(ReKi), INTENT( OUT) :: DELTAP !< REAL(ReKi), INTENT( OUT) :: DSTRS !< @@ -2140,38 +2136,43 @@ SUBROUTINE THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,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 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message +! integer(intKi) :: ErrStat2 ! temporary Error status +! character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'Thick' real(ReKi) :: DELTA0 ! BOUNDARY LAYER THICKNESS AT ZERO ANGLE OF ATTACK METERS real(ReKi) :: DSTR0 ! DISPLACEMENT THICKNESS AT ZERO ANGLE OF ATTACK METERS ErrStat = ErrID_None ErrMsg = "" - ! - DELTA0 = 10.**(1.6569-.9045*LOG10(RC)+.0596*LOG10(RC)**2.)*C - IF (p%ITRIP .GT. 0) DELTA0 = 10.**(1.892-0.9045*LOG(RC)+0.0596*LOG(RC)**2.)*C + ! Boundary layer thickness + DELTA0 = 10.**(1.6569-0.9045*LOG10(RC)+0.0596*LOG10(RC)**2)*C ! (untripped) Eq. (5) of [1] + IF (p%ITRIP .GT. 0) DELTA0 = 10.**(1.892 -0.9045*LOG10(RC)+0.0596*LOG10(RC)**2)*C ! (heavily tripped) Eq. (2) of [1] IF (p%ITRIP .EQ. 2) DELTA0=.6*DELTA0 - ! Pressure side boundary layer thickness - DELTAP = 10.**(-.04175*ALPSTAR+.00106*ALPSTAR**2.)*DELTA0 + ! Pressure side boundary layer thickness, Eq (8) of [1] + DELTAP = 10.**(-.04175*ALPSTAR+.00106*ALPSTAR**2)*DELTA0 ! Compute zero angle of attack displacement thickness IF ((p%ITRIP .EQ. 1) .OR. (p%ITRIP .EQ. 2)) THEN + ! Heavily tripped, Eq. (3) of [1] IF (RC .LE. .3E+06) DSTR0 = .0601 * RC **(-.114)*C IF (RC .GT. .3E+06) & - DSTR0=10.**(3.411-1.5397*LOG10(RC)+.1059*LOG10(RC)**2.)*C + DSTR0=10.**(3.411-1.5397*LOG10(RC)+.1059*LOG10(RC)**2)*C + ! Lightly tripped IF (p%ITRIP .EQ. 2) DSTR0 = DSTR0 * .6 ELSE - DSTR0=10.**(3.0187-1.5397*LOG10(RC)+.1059*LOG10(RC)**2.)*C + ! Untripped, Eq. (6) of [1] + DSTR0=10.**(3.0187-1.5397*LOG10(RC)+.1059*LOG10(RC)**2)*C ENDIF - ! Pressure side displacement thickness - DSTRP = 10.**(-.0432*ALPSTAR+.00113*ALPSTAR**2.)*DSTR0 + ! Pressure side displacement thickness, Eq. (9) of [1] + DSTRP = 10.**(-.0432*ALPSTAR+.00113*ALPSTAR**2)*DSTR0 ! IF (p%ITRIP .EQ. 3) DSTRP = DSTRP * 1.48 ! commented since itrip is never 3 check if meant 2.(EB_DTU) ! Suction side displacement thickness IF (p%ITRIP .EQ. 1) THEN + ! Heavily tripped, Eq. (12) of [1] IF (ALPSTAR .LE. 5.) DSTRS=10.**(.0679*ALPSTAR)*DSTR0 IF((ALPSTAR .GT. 5.).AND.(ALPSTAR .LE. StallVal)) & DSTRS = .381*10.**(.1516*ALPSTAR)*DSTR0 IF (ALPSTAR .GT. StallVal)DSTRS=14.296*10.**(.0258*ALPSTAR)*DSTR0 ELSE + ! Untripped or lightly tripped, Eq. (15) of [1] IF (ALPSTAR .LE. 7.5)DSTRS =10.**(.0679*ALPSTAR)*DSTR0 IF((ALPSTAR .GT. 7.5).AND.(ALPSTAR .LE. StallVal)) & DSTRS = .0162*10.**(.3066*ALPSTAR)*DSTR0 @@ -2199,7 +2200,7 @@ SUBROUTINE DIRECTH_TE(M,THETA,PHI,DBAR, errStat, errMsg) MC = .8 * M THETAR = THETA * DEGRAD PHIR = PHI * DEGRAD - DBAR = 2.*SIN(THETAR/2.)**2.*SIN(PHIR)**2./((1.+M*COS(THETAR))* (1.+(M-MC)*COS(THETAR))**2.) ! eq B1 in BPM Airfoil Self-noise and Prediction paper + DBAR = 2.*SIN(THETAR/2.)**2*SIN(PHIR)**2/((1.+M*COS(THETAR))* (1.+(M-MC)*COS(THETAR))**2) ! eq B1 in BPM Airfoil Self-noise and Prediction paper END SUBROUTINE DIRECTH_TE !==================================================================================================== @@ -2221,7 +2222,7 @@ SUBROUTINE DIRECTH_LE(M,THETA,PHI,DBAR, errStat, errMsg) DEGRAD = .017453 THETAR = THETA * DEGRAD PHIR = PHI * DEGRAD - DBAR = 2.*COS(THETAR/2.)**2.*SIN(PHIR)**2./(1.+M*COS(THETAR))**3. + DBAR = 2.*COS(THETAR/2.)**2*SIN(PHIR)**2/(1.+M*COS(THETAR))**3 END SUBROUTINE DIRECTH_LE !==================================================================================================== @@ -2264,12 +2265,13 @@ SUBROUTINE Simple_Guidati(U,Chord,thick_10p,thick_1p,p,SPLti,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 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message +! integer(intKi) :: ErrStat2 ! temporary Error status +! character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'Simple_Guidati' INTEGER(intKi) :: loop1 ! temporary REAL(ReKi) :: TI_Param ! Temporary variable thickness ratio dependent REAL(ReKi) :: slope ! Temporary variable thickness ratio dependent + ErrStat = ErrID_None ErrMsg = "" @@ -2282,10 +2284,8 @@ END SUBROUTINE Simple_Guidati !==================================================================================================================================! !================================ Turbulent Boundary Layer Trailing Edge Noise ====================================================! !=================================================== TNO START ====================================================================! -SUBROUTINE TBLTE_TNO(ALPSTAR,C,U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SPLS,SPLALPH,SPLTBL,errStat,errMsgn) +SUBROUTINE TBLTE_TNO(U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SPLS,SPLALPH,SPLTBL,errStat,errMsgn) USE TNO, only: SPL_integrate - REAL(ReKi), INTENT(IN ) :: ALPSTAR !< AOA (deg) - REAL(ReKi), INTENT(IN ) :: C !< Chord Length (m) REAL(ReKi), INTENT(IN ) :: U !< Unoise (m/s) REAL(ReKi), INTENT(IN ) :: THETA !< DIRECTIVITY ANGLE (deg) REAL(ReKi), INTENT(IN ) :: PHI !< DIRECTIVITY ANGLE (deg) @@ -2346,7 +2346,7 @@ SUBROUTINE TBLTE_TNO(ALPSTAR,C,U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SP answer = SPL_integrate(omega=omega,limits=int_limits,ISSUCTION=.true., & Mach=Mach,SpdSound=p%SpdSound,AirDens=p%AirDens,KinVisc=p%KinVisc, & Cfall=Cfall,d99all=d99all,EdgeVelAll=EdgeVelAll) - Spectrum = D/(4.*pi*R**2.)*answer + Spectrum = D/(4.*pi*R**2)*answer SPL_suction = 10.*log10(Spectrum*DBARH/2.e-5/2.e-5) SPLS(i_omega) = SPL_suction + 10.*log10(band_width) ENDIF @@ -2355,7 +2355,7 @@ SUBROUTINE TBLTE_TNO(ALPSTAR,C,U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SP answer = SPL_integrate(omega=omega,limits=int_limits,ISSUCTION=.FALSE., & Mach=Mach,SpdSound=p%SpdSound,AirDens=p%AirDens,KinVisc=p%KinVisc, & Cfall=Cfall,d99all=d99all,EdgeVelAll=EdgeVelAll) - Spectrum = D/(4.*pi*R**2.)*answer + Spectrum = D/(4.*pi*R**2)*answer SPL_press = 10.*log10(Spectrum*DBARH/2.e-5/2.e-5) SPLP(i_omega) = SPL_press + 10.*log10(band_width) ENDIF @@ -2441,9 +2441,9 @@ SUBROUTINE BL_Param_Interp(p,m,U,AlphaNoise,C,whichairfoil, errStat, errMsg) if (loop2 .eq. (size(p%AOAListBL)-1) ) then if (AlphaNoise .gt. p%AOAListBL(size(p%AOAListBL))) then - print*, 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the range provided by the user' - print*, 'Station ',whichairfoil - print*, 'Airfoil AoA ',AlphaNoise,' Using the closest AoA ',p%AOAListBL(loop2+1) + CALL WrScr( 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the range provided by the user') + CALL WrScr( 'Station '// trim(num2lstr(whichairfoil)) ) + CALL WrScr( 'Airfoil AoA '//trim(num2lstr(AlphaNoise))//'; Using the closest AoA '//trim(num2lstr(p%AOAListBL(loop2+1)))) m%dStarVar (1) = ( p%dstarall1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%dstarall1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) m%dStarVar (2) = ( p%dstarall2 (loop2+1,loop1+1,whichairfoil)*redif2 + p%dstarall2 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) m%d99Var (1) = ( p%d99all1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%d99all1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) @@ -2453,9 +2453,9 @@ SUBROUTINE BL_Param_Interp(p,m,U,AlphaNoise,C,whichairfoil, errStat, errMsg) m%EdgeVelVar(1) = ( p%EdgeVelRat1(loop2+1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat1(loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) m%EdgeVelVar(2) = ( p%EdgeVelRat2(loop2+1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat2(loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) elseif (AlphaNoise .lt. p%AOAListBL(1)) then - print*, 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the range provided by the user' - print*, 'Station ',whichairfoil - print*, 'Airfoil AoA ',AlphaNoise,' Using the closest AoA ',p%AOAListBL(1) + CALL WrScr( 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the range provided by the user') + CALL WrScr( 'Station '// trim(num2lstr(whichairfoil)) ) + CALL WrScr( 'Airfoil AoA '//trim(num2lstr(AlphaNoise))//'; Using the closest AoA '//trim(num2lstr(p%AOAListBL(1))) ) m%dStarVar(1) = ( p%dstarall1 (1,loop1+1,whichairfoil)*redif2 + p%dstarall1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) m%dStarVar(2) = ( p%dstarall2 (1,loop1+1,whichairfoil)*redif2 + p%dstarall2 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) m%d99Var(1) = ( p%d99all1 (1,loop1+1,whichairfoil)*redif2 + p%d99all1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) @@ -2487,7 +2487,7 @@ SUBROUTINE Aero_Tests() !m%SPLP=0.0_ReKi;m%SPLS=0.0_ReKi;m%SPLTBL=0.0_ReKi; !m%EdgeVelVar(1)=1.000d0;m%EdgeVelVar(2)=m%EdgeVelVar(1); !m%CfVar(1) = 0.0003785760d0;m%CfVar(2) = 0.001984380d0;m%d99var(1)= 0.01105860d0; m%d99var(2)= 0.007465830d0;m%EdgeVelVar(1)=1.000d0;m%EdgeVelVar(2)=m%EdgeVelVar(1); - !CALL TBLTE_TNO(3.0_Reki,0.22860_Reki,63.9200_Reki,90.00_Reki,90.0_Reki,0.5090_Reki,1.220_Reki, & + !CALL TBLTE_TNO(0.22860_Reki,63.9200_Reki,90.00_Reki,90.0_Reki,0.5090_Reki,1.220_Reki, & ! m%CfVar,m%d99var,m%EdgeVelVar, p, m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,ErrStat2 ,errMsg2) !--------Blunt Trailing Edge Noise----------------------------------------------! !CALL BLUNT(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0,& @@ -2496,8 +2496,7 @@ SUBROUTINE Aero_Tests() !CALL TIPNOIS(AlphaNoise,p%ALpRAT,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & ! m%rTEtoObserve(K,J,I), p, m%SPLTIP,ErrStat2,errMsg2) !--------Inflow Turbulence Noise ------------------------------------------------! - !CALL InflowNoise(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & - ! xd%MeanVrel(J,I),0.050d0,0.050d0,p,m%SPLti,ErrStat2,errMsg2 ) + !CALL InflowNoise(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, xd%TIVx(J,I),0.050d0,p,m%SPLti,ErrStat2,errMsg2 ) !CALL FullGuidati(3.0d0,63.920d0,0.22860d0,0.5090d0,1.220d0,90.0d0,90.0d0,xd%MeanVrel(J,I),xd%TIVrel(J,I), & ! p,p%BlAFID(J,I),m%SPLTIGui,ErrStat2 ) !CALL Simple_Guidati(UNoise,0.22860d0,0.120d0,0.020d0,p,m%SPLTIGui,ErrStat2,errMsg2 ) diff --git a/modules/aerodyn/src/AeroAcoustics_IO.f90 b/modules/aerodyn/src/AeroAcoustics_IO.f90 index cbb1666d55..28679b5992 100644 --- a/modules/aerodyn/src/AeroAcoustics_IO.f90 +++ b/modules/aerodyn/src/AeroAcoustics_IO.f90 @@ -15,10 +15,6 @@ MODULE AeroAcoustics_IO INTEGER(IntKi), PARAMETER :: Time = 0 - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - INTEGER(IntKi), PARAMETER :: MaxBl = 3 ! Maximum number of blades allowed in simulation ! model identifiers @@ -58,22 +54,20 @@ MODULE AeroAcoustics_IO contains !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadInputFiles( InputFileName, BL_Files, InputFileData, Default_DT, OutFileRoot, NumBlades, UnEcho, ErrStat, ErrMsg ) +SUBROUTINE ReadInputFiles( InputFileName, AFI, InputFileData, Default_DT, OutFileRoot, UnEcho, ErrStat, ErrMsg ) ! This subroutine reads the input file and stores all the data in the AA_InputFile structure. ! It does not perform data validation. !.................................................................................................................................. ! Passed variables REAL(DbKi), INTENT(IN) :: Default_DT ! The default DT (from glue code) CHARACTER(*), INTENT(IN) :: InputFileName ! Name of the aeroacoustics input file - CHARACTER(*), dimension(:), INTENT(IN) :: BL_Files ! Name of the BL input file + TYPE(AFI_ParameterType), INTENT(IN) :: AFI(:) ! airfoil array: contains names of the BL input file CHARACTER(*), INTENT(IN) :: OutFileRoot ! The rootname of all the output files written by this routine. TYPE(AA_InputFile), INTENT(OUT) :: InputFileData ! Data stored in the module's input file INTEGER(IntKi), INTENT(OUT) :: UnEcho ! Unit number for the echo file - INTEGER(IntKi), INTENT(IN) :: NumBlades ! Number of blades for this model INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status code CHARACTER(*), INTENT(OUT) :: ErrMsg ! The error message, if an error occurred ! local variables - INTEGER(IntKi) :: I INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred CHARACTER(*), PARAMETER :: RoutineName = 'ReadInputFiles' @@ -88,15 +82,15 @@ SUBROUTINE ReadInputFiles( InputFileName, BL_Files, InputFileData, Default_DT, O if(Failed()) return ! get the blade input-file data - ALLOCATE( InputFileData%BladeProps( size(BL_Files) ), STAT = ErrStat2 ) + ALLOCATE( InputFileData%BladeProps( size(AFI) ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating memory for BladeProps.", ErrStat, ErrMsg, RoutineName) return END IF - if ((InputFileData%ITURB==2) .or. (InputFileData%X_BLMethod==2) .or. (InputFileData%IBLUNT==1)) then + if ((InputFileData%ITURB==2) .or. (InputFileData%X_BLMethod==X_BLMethod_Tables) .or. (InputFileData%IBLUNT==1)) then ! We need to read the BL tables - CALL ReadBLTables( InputFileName, BL_Files, InputFileData, ErrStat2, ErrMsg2 ) + CALL ReadBLTables( InputFileName, AFI, InputFileData, ErrStat2, ErrMsg2 ) if (Failed())return endif @@ -123,10 +117,8 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U character(*), intent(in) :: OutFileRoot ! The rootname of the echo file, possibly opened in this routine type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file ! Local variables: - real(ReKi) :: TmpAry(3) ! array to help read tower properties table integer(IntKi) :: I ! loop counter integer(IntKi) :: UnIn,UnIn2 ! Unit number for reading file - integer(IntKi) :: loop1 ! loop counter character(1024) :: ObserverFile ! name of the files containing obesever location integer(IntKi) :: ErrStat2, IOS,cou ! Temporary Error status logical :: Echo ! Determines if an echo file should be written @@ -134,7 +126,6 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U character(1024) :: PriPath ! Path name of the primary file character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") character(*), parameter :: RoutineName = 'ReadPrimaryFile' - integer(IntKi) :: n ! dummy integer ! Initialize some variables: ErrStat = ErrID_None ErrMsg = "" @@ -144,8 +135,8 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. ! Open the Primary input file. - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ); call check - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ); call check + CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ); call check() + CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ); call check() IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -157,21 +148,21 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U I = 1 !set the number of times we've read the file DO !----------- HEADER ------------------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ); call check - CALL ReadStr( UnIn, InputFile, InputFileData%FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ); call check + CALL ReadCom( UnIn, InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ); call check() + CALL ReadStr( UnIn, InputFile, InputFileData%FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ); call check() IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN END IF !----------- GENERAL OPTIONS ---------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: General Options', ErrStat2, ErrMsg2, UnEc ); call check + CALL ReadCom( UnIn, InputFile, 'Section Header: General Options', ErrStat2, ErrMsg2, UnEc ); call check() ! Echo - Echo input to ".AD.ech". - CALL ReadVar( UnIn, InputFile, Echo, 'Echo', 'Echo flag', ErrStat2, ErrMsg2, UnEc); call check + CALL ReadVar( UnIn, InputFile, Echo, 'Echo', 'Echo flag', ErrStat2, ErrMsg2, UnEc); call check() IF (.NOT. Echo .OR. I > 1) EXIT !exit this loop ! Otherwise, open the echo file, then rewind the input file and echo everything we've read I = I + 1 ! make sure we do this only once (increment counter that says how many times we've read this file) - CALL OpenEcho ( UnEc, TRIM(OutFileRoot)//'.ech', ErrStat2, ErrMsg2, AA_Ver ); call check + CALL OpenEcho ( UnEc, TRIM(OutFileRoot)//'.ech', ErrStat2, ErrMsg2, AA_Ver ); call check() IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -192,12 +183,12 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U ! DT_AA - Time interval for aerodynamic calculations {or default} (s): Line = "" - CALL ReadVar( UnIn, InputFile, Line, "DT_AA", "Time interval for aeroacoustics calculations {or default} (s)", ErrStat2, ErrMsg2, UnEc); call check + CALL ReadVar( UnIn, InputFile, Line, "DT_AA", "Time interval for aeroacoustics calculations {or default} (s)", ErrStat2, ErrMsg2, UnEc); call check() CALL Conv2UC( Line ) IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If DT_AA is not "default", read it and make sure it is a multiple of DTAero from AeroDyn. Else, just use DTAero READ( Line, *, IOSTAT=IOS) InputFileData%DT_AA - CALL CheckIOS ( IOS, InputFile, 'DT_AA', NumType, ErrStat2, ErrMsg2 ); call check + CALL CheckIOS ( IOS, InputFile, 'DT_AA', NumType, ErrStat2, ErrMsg2 ); call check() IF (abs(InputFileData%DT_AA / Default_DT - NINT(InputFileData%DT_AA / Default_DT)) .gt. 1E-10) THEN CALL SetErrStat(ErrID_Fatal,"The Aeroacoustics input DT_AA must be a multiple of DTAero.", ErrStat, ErrMsg, RoutineName) @@ -207,21 +198,21 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U InputFileData%DT_AA = Default_DT END IF - CALL ReadVar(UnIn,InputFile,InputFileData%AAStart ,"AAStart" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar(UnIn,InputFile,InputFileData%AA_Bl_Prcntge,"BldPrcnt" ,"-",ErrStat2,ErrMsg2,UnEc); call check - CALL ReadCom( UnIn, InputFile, 'Section Header: Aeroacoustic Models', ErrStat2, ErrMsg2, UnEc ); call check - CALL ReadVar(UnIn,InputFile,InputFileData%IInflow ,"InflowMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar(UnIn,InputFile,InputFileData%TICalcMeth ,"TICalcMeth" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVAr(UnIn,InputFile,InputFileData%TICalcTabFile,"TICalcTabFile","" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar(UnIn,InputFile,InputFileData%Lturb ,"Lturb" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar(UnIn,InputFile,InputFileData%ITURB ,"TurbMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check ! ITURB - TBLTE NOISE - CALL ReadVar(UnIn,InputFile,InputFileData%X_BLMethod ,"BLMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar(UnIn,InputFile,InputFileData%ITRIP ,"TripMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar(UnIn,InputFile,InputFileData%ILAM ,"LamMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar(UnIn,InputFile,InputFileData%ITIP ,"TipMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar(UnIn,InputFile,InputFileData%ROUND ,"RoundTip" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar(UnIn,InputFile,InputFileData%ALPRAT ,"ALPRAT" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar(UnIn,InputFile,InputFileData%IBLUNT ,"BluntMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%AAStart ,"AAStart" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVar(UnIn,InputFile,InputFileData%AA_Bl_Prcntge,"BldPrcnt" ,"-",ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadCom( UnIn, InputFile, 'Section Header: Aeroacoustic Models', ErrStat2, ErrMsg2, UnEc ); call check() + CALL ReadVar(UnIn,InputFile,InputFileData%IInflow ,"InflowMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVar(UnIn,InputFile,InputFileData%TICalcMeth ,"TICalcMeth" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVAr(UnIn,InputFile,InputFileData%TICalcTabFile,"TICalcTabFile","" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVar(UnIn,InputFile,InputFileData%Lturb ,"Lturb" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVar(UnIn,InputFile,InputFileData%ITURB ,"TurbMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() ! ITURB - TBLTE NOISE + CALL ReadVar(UnIn,InputFile,InputFileData%X_BLMethod ,"BLMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVar(UnIn,InputFile,InputFileData%ITRIP ,"TripMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVar(UnIn,InputFile,InputFileData%ILAM ,"LamMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVar(UnIn,InputFile,InputFileData%ITIP ,"TipMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVar(UnIn,InputFile,InputFileData%ROUND ,"RoundTip" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVar(UnIn,InputFile,InputFileData%ALPRAT ,"ALPRAT" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVar(UnIn,InputFile,InputFileData%IBLUNT ,"BluntMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() ! Return on error at end of section IF ( ErrStat >= AbortErrLev ) THEN @@ -230,29 +221,29 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U END IF !----------- OBSERVER INPUT ------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: Observer Input ', ErrStat2, ErrMsg2, UnEc ); call check + CALL ReadCom( UnIn, InputFile, 'Section Header: Observer Input ', ErrStat2, ErrMsg2, UnEc ); call check() !----- read from observer file - CALL ReadVar ( UnIn, InputFile, ObserverFile, ObserverFile, 'Name of file observer locations', ErrStat2, ErrMsg2, UnEc ); call check + CALL ReadVar ( UnIn, InputFile, ObserverFile, ObserverFile, 'Name of file observer locations', ErrStat2, ErrMsg2, UnEc ); call check() IF ( PathIsRelative( ObserverFile ) ) ObserverFile = TRIM(PriPath)//TRIM(ObserverFile) - CALL GetNewUnit( UnIn2, ErrStat2, ErrMsg2 ); call check + CALL GetNewUnit( UnIn2, ErrStat2, ErrMsg2 ); call check() - CALL OpenFInpFile ( UnIn2, ObserverFile, ErrStat2, ErrMsg2 ); call check + CALL OpenFInpFile ( UnIn2, ObserverFile, ErrStat2, ErrMsg2 ); call check() IF ( ErrStat >= AbortErrLev ) RETURN ! NrObsLoc - Nr of Observers (-): - CALL ReadVar( UnIn2, ObserverFile, InputFileData%NrObsLoc, "NrObsLoc", "Nr of Observers (-)", ErrStat2, ErrMsg2, UnEc); call check + CALL ReadVar( UnIn2, ObserverFile, InputFileData%NrObsLoc, "NrObsLoc", "Nr of Observers (-)", ErrStat2, ErrMsg2, UnEc); call check() ! Observer location in tower-base coordinate (m): - CALL AllocAry( InputFileData%ObsX,InputFileData%NrObsLoc, 'ObsX', ErrStat2, ErrMsg2); call check - CALL AllocAry( InputFileData%ObsY,InputFileData%NrObsLoc, 'ObsY', ErrStat2, ErrMsg2); call check - CALL AllocAry( InputFileData%ObsZ,InputFileData%NrObsLoc, 'ObsZ', ErrStat2, ErrMsg2); call check + CALL AllocAry( InputFileData%ObsX,InputFileData%NrObsLoc, 'ObsX', ErrStat2, ErrMsg2); call check() + CALL AllocAry( InputFileData%ObsY,InputFileData%NrObsLoc, 'ObsY', ErrStat2, ErrMsg2); call check() + CALL AllocAry( InputFileData%ObsZ,InputFileData%NrObsLoc, 'ObsZ', ErrStat2, ErrMsg2); call check() - CALL ReadCom( UnIn2, InputFile, ' Header', ErrStat2, ErrMsg2, UnEc ); call check + CALL ReadCom( UnIn2, InputFile, ' Header', ErrStat2, ErrMsg2, UnEc ); call check() DO cou=1,InputFileData%NrObsLoc READ( UnIn2, *, IOStat=IOS ) InputFileData%ObsX(cou), InputFileData%ObsY(cou), InputFileData%ObsZ(cou) - CALL CheckIOS( IOS, ObserverFile, 'Obeserver Locations '//TRIM(Num2LStr(cou)), NumType, ErrStat2, ErrMsg2 ); call check + CALL CheckIOS( IOS, ObserverFile, 'Obeserver Locations '//TRIM(Num2LStr(cou)), NumType, ErrStat2, ErrMsg2 ); call check() ! Return on error if we couldn't read this line IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() @@ -263,11 +254,11 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U !----- end read from observer file !----------- OUTPUTS ----------------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Outputs', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn,InputFile,InputFileData%aweightflag ,"AWeighting" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%NrOutFile, "NrOutFile", "Nr of Output Files (-)", ErrStat2, ErrMsg2, UnEc); call check - CALL AllocAry( InputFileData%AAOutFile,InputFileData%NrOutFile, 'AAOutFile', ErrStat2, ErrMsg2); call check - CALL ReadVar ( UnIn, InputFile, InputFileData%AAOutFile(1), 'AAOutFile', 'Name of output file ', ErrStat2, ErrMsg2, UnEc ); call check + CALL ReadCom( UnIn, InputFile, 'Section Header: Outputs', ErrStat2, ErrMsg2, UnEc); call check() + CALL ReadVar( UnIn,InputFile,InputFileData%aweightflag ,"AWeighting" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVar( UnIn, InputFile, InputFileData%NrOutFile, "NrOutFile", "Nr of Output Files (-)", ErrStat2, ErrMsg2, UnEc); call check() + CALL AllocAry( InputFileData%AAOutFile,InputFileData%NrOutFile, 'AAOutFile', ErrStat2, ErrMsg2); call check() + CALL ReadVar ( UnIn, InputFile, InputFileData%AAOutFile(1), 'AAOutFile', 'Name of output file ', ErrStat2, ErrMsg2, UnEc ); call check() DO I=InputFileData%NrOutFile,1,-1 ! one file name is given by the user and the XXFile1.out XXFile2.out XXFile3.out is generated IF ( PathIsRelative( InputFileData%AAOutFile(I) ) ) InputFileData%AAOutFile(I) = TRIM(PriPath)//TRIM(InputFileData%AAOutFile(1))//TRIM(Num2Lstr(I))//".out" @@ -322,38 +313,37 @@ subroutine ReadRealMatrix(fid, FileName, Mat, VarName, nLines,nRows, iStat, Msg, -SUBROUTINE ReadBLTables( InputFile, BL_Files, InputFileData, ErrStat, ErrMsg ) +SUBROUTINE ReadBLTables( InputFile, AFI, InputFileData, ErrStat, ErrMsg ) ! Passed variables character(*), intent(in) :: InputFile ! Name of the file containing the primary input data - character(*), dimension(:), intent(in) :: BL_Files ! Name of the file containing the primary input data -type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file + TYPE(AFI_ParameterType), INTENT(IN) :: AFI(:) ! airfoil array: contains names of the BL input file + type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file integer(IntKi), intent(out) :: ErrStat ! Error status character(*), intent(out) :: ErrMsg ! Error message + ! Local variables: - integer(IntKi) :: UnIn,UnIn2 ! Unit number for reading file - character(1024) :: FileName ! name of the files containing obesever location - integer(IntKi) :: ErrStat2 ! Temporary Error status - logical :: Echo ! Determines if an echo file should be written + 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(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents - character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") - character(*), parameter :: RoutineName = 'readbltable' - integer(IntKi) :: nRe, nAoA, nAirfoils ! Number of Reynolds number, angle of attack, and number of airfoils listed - integer(IntKi) :: iAF , iRe, iAoA, iDummy, iBuffer ! loop counters - real(DbKi),dimension(:,:),ALLOCATABLE :: Buffer - integer :: iLine + character(*), parameter :: RoutineName = 'ReadBLTables' + integer(IntKi) :: nRe, nAoA, nAirfoils ! Number of Reynolds number, angle of attack, and number of airfoils listed + integer(IntKi) :: iAF , iRe, iAoA ! loop counters + real(DbKi), ALLOCATABLE :: Buffer(:,:) + integer :: iLine + ! 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. - nAirfoils = size(BL_Files) + nAirfoils = size(AFI) do iAF=1,nAirfoils - FileName = trim(BL_Files(iAF)) + FileName = trim(AFI(iAF)%BL_file) - print*,'AeroAcoustics_IO: reading BL table:'//trim(Filename) + call WrScr('AeroAcoustics_IO: reading BL table:'//trim(Filename)) CALL GetNewUnit(UnIn, ErrStat2, ErrMsg2); if(Failed()) return CALL OpenFInpFile(UnIn, FileName, ErrStat2, ErrMsg2); if(Failed()) return @@ -440,16 +430,11 @@ SUBROUTINE ReadTICalcTables(InputFile, InputFileData, ErrStat, ErrMsg) 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) :: I ! loop counter - integer(IntKi) :: UnIn,UnIn2 ! Unit number for reading file - integer(IntKi) :: loop1 ! loop counter - character(1024) :: FileName ! name of the files containing obesever location - integer(IntKi) :: ErrStat2, IOS,cou ! Temporary Error status - logical :: Echo ! Determines if an echo file should be written + 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(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents - character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") character(*), parameter :: RoutineName = 'REadTICalcTables' integer(IntKi) :: GridY ! integer(IntKi) :: GridZ ! @@ -464,16 +449,16 @@ SUBROUTINE ReadTICalcTables(InputFile, InputFileData, ErrStat, ErrMsg) 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 + 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); @@ -505,8 +490,6 @@ SUBROUTINE ValidateInputData( InputFileData, NumBl, ErrStat, ErrMsg ) 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 = 'ValidateInputData' ErrStat = ErrID_None ErrMsg = "" @@ -553,33 +536,10 @@ SUBROUTINE ValidateInputData( InputFileData, NumBl, ErrStat, ErrMsg ) END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE AA_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) - ! This routine generates the summary file, which contains a summary of input file options. - ! passed variables - TYPE(AA_InputFile), INTENT(IN) :: InputFileData ! Input-file data - TYPE(AA_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AA_InputType), INTENT(IN) :: u ! inputs - TYPE(AA_OutputType), INTENT(IN) :: y ! outputs - INTEGER(IntKi), INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMsg - ! Local variables. - INTEGER(IntKi) :: I ! Index for the nodes. - INTEGER(IntKi) :: UnSu ! I/O unit number for the summary output file - CHARACTER(*), PARAMETER :: FmtDat = '(A,T35,1(:,F13.3))' ! Format for outputting mass and modal data. - CHARACTER(*), PARAMETER :: FmtDatT = '(A,T35,1(:,F13.8))' ! Format for outputting time steps. - CHARACTER(30) :: OutPFmt ! Format to print list of selected output channels to summary file - CHARACTER(100) :: Msg ! temporary string for writing appropriate text to summary file - ! Open the summary file and give it a heading. - ErrStat = ErrID_None - ErrMsg = "" - RETURN -END SUBROUTINE AA_PrintSum -!.................................................................................................................................. !> This subroutine sets the initialization output data structure, which contains data to be returned to the calling program (e.g., !! FAST or AeroAcoustics_Driver) -subroutine AA_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) +subroutine AA_SetInitOut(p, InitOut, errStat, errMsg) type(AA_InitOutputType), intent( out) :: InitOut ! output data - type(AA_InputFile), intent(in ) :: InputFileData ! input file data (for setting airfoil shape outputs) type(AA_ParameterType), intent(in ) :: p ! Parameters integer(IntKi), intent( out) :: errStat ! Error status of the operation character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None @@ -587,9 +547,7 @@ subroutine AA_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'AA_SetInitOut' - integer(IntKi) :: i, j, k,m,oi - integer(IntKi) :: NumCoords - character(500) :: chanPrefix + integer(IntKi) :: i, j, k,oi ! Initialize variables for this routine errStat = ErrID_None errMsg = "" @@ -668,8 +626,7 @@ subroutine AA_InitializeOutputFile(p, InputFileData,InitOut,errStat, errMsg) ! locals integer(IntKi) :: i integer(IntKi) :: numOuts - character(200) :: frmt ! A string to hold a format specifier - character(15) :: tmpStr ! temporary string to print the time output as text + ! FIRST FILE IF (InputFileData%NrOutFile .gt.0) THEN call GetNewUnit( p%unOutFile, ErrStat, ErrMsg ) @@ -880,8 +837,8 @@ SUBROUTINE Calc_WriteOutput( p, u, m, y, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred ! local variables CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' - INTEGER(intKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 +! INTEGER(intKi) :: ErrStat2 +! CHARACTER(ErrMsgLen) :: ErrMsg2 INTEGER(IntKi) :: j,k,counter,i,oi,III ! start routine: ErrStat = ErrID_None diff --git a/modules/aerodyn/src/AeroAcoustics_TNO.f90 b/modules/aerodyn/src/AeroAcoustics_TNO.f90 index a2d9ab2b8c..761f45ad1e 100644 --- a/modules/aerodyn/src/AeroAcoustics_TNO.f90 +++ b/modules/aerodyn/src/AeroAcoustics_TNO.f90 @@ -169,7 +169,6 @@ END FUNCTION f_int2 FUNCTION Pressure(k1_in) ! Variables REAL(TNOKi) :: a,b,answer - REAL(TNOKi) :: omega REAL(TNOKi) :: abserr,resabs,resasc REAL(TNOKi) :: k1_in real(TNOKi) :: Pressure @@ -189,7 +188,7 @@ FUNCTION Pressure(k1_in) CALL slatec_qk61(f_int1,a,b,answer,abserr,resabs,resasc) - Pressure = 4.*rho**2*k1**2./(k1**2.+k3**2.)*answer + Pressure = 4.0_TNOKi*rho**2 * k1**2 / (k1**2 + k3**2)*answer RETURN END FUNCTION Pressure diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 21b3557bce..011c772051 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -300,15 +300,27 @@ SUBROUTINE AA_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, DstBladePropsTypeData%TEAngle = SrcBladePropsTypeData%TEAngle END SUBROUTINE AA_CopyBladePropsType - SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_BladePropsType), INTENT(INOUT) :: BladePropsTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyBladePropsType' + LOGICAL,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 ) @@ -501,15 +513,27 @@ SUBROUTINE AA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt ENDIF END SUBROUTINE AA_CopyInitInput - SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitInput' + LOGICAL,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 @@ -521,7 +545,8 @@ SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InitInputData%AFInfo)) THEN DO i1 = LBOUND(InitInputData%AFInfo,1), UBOUND(InitInputData%AFInfo,1) - CALL AFI_DestroyParam( InitInputData%AFInfo(i1), ErrStat, ErrMsg ) + CALL AFI_DestroyParam( InitInputData%AFInfo(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%AFInfo) ENDIF @@ -1052,15 +1077,27 @@ SUBROUTINE AA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%AirDens = SrcInitOutputData%AirDens END SUBROUTINE AA_CopyInitOutput - SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitOutput' + LOGICAL,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 @@ -1085,7 +1122,8 @@ SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitOutputData%WriteOutputUntNodes)) THEN DEALLOCATE(InitOutputData%WriteOutputUntNodes) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) + 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 ) @@ -1889,15 +1927,27 @@ SUBROUTINE AA_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%dy_turb_in = SrcInputFileData%dy_turb_in END SUBROUTINE AA_CopyInputFile - SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInputFile' + LOGICAL,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 @@ -1909,7 +1959,8 @@ SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%BladeProps)) THEN DO i1 = LBOUND(InputFileData%BladeProps,1), UBOUND(InputFileData%BladeProps,1) - CALL AA_Destroybladepropstype( InputFileData%BladeProps(i1), ErrStat, ErrMsg ) + CALL AA_Destroybladepropstype( InputFileData%BladeProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputFileData%BladeProps) ENDIF @@ -3051,15 +3102,27 @@ SUBROUTINE AA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE AA_CopyContState - SUBROUTINE AA_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyContState' + LOGICAL,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 ) @@ -3336,15 +3399,27 @@ SUBROUTINE AA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE AA_CopyDiscState - SUBROUTINE AA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyDiscState' + LOGICAL,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 @@ -4040,15 +4115,27 @@ SUBROUTINE AA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE AA_CopyConstrState - SUBROUTINE AA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyConstrState' + LOGICAL,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 ) @@ -4165,15 +4252,27 @@ SUBROUTINE AA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE AA_CopyOtherState - SUBROUTINE AA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOtherState' + LOGICAL,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 ) @@ -4575,15 +4674,27 @@ SUBROUTINE AA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%filesopen = SrcMiscData%filesopen END SUBROUTINE AA_CopyMisc - SUBROUTINE AA_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyMisc' + LOGICAL,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 @@ -6213,15 +6324,27 @@ SUBROUTINE AA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AA_CopyParam - SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyParam' + LOGICAL,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 @@ -6254,7 +6377,8 @@ SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -6275,7 +6399,8 @@ SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%AFInfo)) THEN DO i1 = LBOUND(ParamData%AFInfo,1), UBOUND(ParamData%AFInfo,1) - CALL AFI_DestroyParam( ParamData%AFInfo(i1), ErrStat, ErrMsg ) + CALL AFI_DestroyParam( ParamData%AFInfo(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%AFInfo) ENDIF @@ -8441,15 +8566,27 @@ SUBROUTINE AA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AA_CopyInput - SUBROUTINE AA_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInput' + LOGICAL,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 @@ -9021,15 +9158,27 @@ SUBROUTINE AA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE AA_CopyOutput - SUBROUTINE AA_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE AA_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AA_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOutput' + LOGICAL,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 diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 14c1705cd2..608d001603 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -109,7 +109,7 @@ subroutine AD_SetInitOut(p, p_AD, InputFileData, InitOut, errStat, errMsg) ! Set the info in WriteOutputHdr and WriteOutputUnt - CALL AllBldNdOuts_InitOut( InitOut, p, p_AD, InputFileData, ErrStat2, ErrMsg2 ) + CALL AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -230,7 +230,6 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut type(FileInfoType) :: FileInfo_In !< The derived type for holding the full input file for parsing -- we may pass this in the future type(AD_InputFile) :: InputFileData ! Data stored in the module's input file after parsing character(1024) :: PriPath !< Primary path - character(1024) :: EchoFileName integer(IntKi) :: UnEcho ! Unit number for the echo file integer(IntKi) :: nRotors ! Number of rotors integer(IntKi), allocatable, dimension(:) :: NumBlades ! Number of blades per rotor @@ -262,6 +261,8 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut 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 rotor params/misc', errStat, errMsg, RoutineName ) if (errStat/=ErrID_None) then call Cleanup() return @@ -270,7 +271,6 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! set a few parameters needed while reading the input file - allocate(NumBlades(nRotors)) do iR = 1, nRotors call ValidateNumBlades( InitInp%rotors(iR)%NumBlades, ErrStat2, ErrMsg2 ) if (Failed()) return; @@ -1089,7 +1089,7 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err p%CompAA = InputFileData%CompAA - ! NOTE: In the following we use InputFileData%BladeProps(1)%NumBlNds as the number of aero nodes on EACH blade, + ! NOTE: In the following we use RotData%BladeProps(1)%NumBlNds as the number of aero nodes on EACH blade, ! but if AD changes this, then it must be handled in the Glue-code linearization code, too (and elsewhere?) ! if (p%NumBlades>0) then p%NumBlNds = RotData%BladeProps(1)%NumBlNds @@ -1118,7 +1118,7 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err !p%AFI ! set in call to AFI_Init() [called early because it wants to use the same echo file as AD] !p%BEMT ! set in call to BEMT_Init() - !p%RootName = TRIM(InitInp%RootName)//'.AD' ! set earlier to it could be used + !p%RootName = TRIM(InitInp%RootName)//'.AD' ! set earlier so it could be used p%numOuts = InputFileData%NumOuts p%NBlOuts = InputFileData%NBlOuts @@ -1349,7 +1349,6 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ! NOTE: m%BEMT_u(i) indices are set differently from the way OpenFAST typically sets up the u and uTimes arrays integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: i integer(intKi) :: iR ! Loop on rotors integer(intKi) :: ErrStat2 @@ -1369,7 +1368,9 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ! 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), ErrStat, ErrMsg) + 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 enddo if (p%WakeMod == WakeMod_FVW) then @@ -1377,72 +1378,56 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, call SetInputsForFVW(p, (/u/), m, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Calculate Outputs at time t - CALL FVW_CalcOutput( t, m%FVW_u(1), p%FVW, x%FVW, xd%FVW, z%FVW, OtherState%FVW, p%AFI, m%FVW_y, m%FVW, ErrStat2, ErrMsg2 ) + 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) call SetOutputsFromFVW( t, u, p, OtherState, x, xd, m, y, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) endif + ! Cavitation check + call AD_CavtCrit(u, p, m, errStat2, errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) !------------------------------------------------------- ! get values to output to file: !------------------------------------------------------- if (CalcWriteOutput) then do iR = 1,size(p%rotors) - if (p%rotors(iR)%NumOuts > 0) then - call Calc_WriteOutput( p%rotors(iR), p, u%rotors(iR), m%rotors(iR), m, y%rotors(iR), OtherState%rotors(iR), xd%rotors(iR), indx, iR, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... - - do i = 1,p%rotors(iR)%NumOuts ! Loop through all selected output channels - y%rotors(iR)%WriteOutput(i) = p%rotors(iR)%OutParam(i)%SignM * m%rotors(iR)%AllOuts( p%rotors(iR)%OutParam(i)%Indx ) - end do ! i - All selected output channels - - end if - - y%rotors(iR)%WriteOutput(p%rotors(iR)%NumOuts+1:) = 0.0_ReKi - - ! Now we need to populate the blade node outputs here - if (p%rotors(iR)%NumBlades > 0) then - call Calc_WriteAllBldNdOutput( p%rotors(iR), p, u%rotors(iR), m%rotors(iR), m, x%rotors(iR), y%rotors(iR), OtherState%rotors(iR), indx, iR, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - endif - enddo + 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) + end do end if - end subroutine AD_CalcOutput - -subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg) +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine RotCalcOutput( t, u, 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. !.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(RotInputType), INTENT(IN ) :: u !< Inputs 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 - TYPE(RotDiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(RotConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(RotOtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(RotOutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - 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 + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(RotInputType), INTENT(IN ) :: u !< Inputs 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 + TYPE(RotDiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(RotConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + TYPE(RotOtherStateType), INTENT(IN ) :: OtherState !< Other states at t + TYPE(RotOutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + 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 + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedWriteOutput !< Flag to determine if WriteOutput values need to be calculated in this call + ! NOTE: m%BEMT_u(i) indices are set differently from the way OpenFAST typically sets up the u and uTimes arrays integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: i - integer(intKi) :: j - integer(intKi) :: iR ! Loop on rotors integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -1451,6 +1436,12 @@ subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, Er ErrStat = ErrID_None ErrMsg = "" + + if (present(NeedWriteOutput)) then + CalcWriteOutput = NeedWriteOutput + else + 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1478,58 +1469,138 @@ subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, Er call ADTwr_CalcOutput(p, u, m, y, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) endif - - call AD_CavtCrit(u, p, m, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + + !------------------------------------------------------- + ! 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) + end if end subroutine RotCalcOutput +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine RotWriteOutputs( t, u, 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. +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(RotInputType), INTENT(IN ) :: u !< Inputs 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 + TYPE(RotDiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(RotConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + TYPE(RotOtherStateType), INTENT(IN ) :: OtherState !< Other states at t + TYPE(RotOutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + 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 + + + ! NOTE: m%BEMT_u(i) indices are set differently from the way OpenFAST typically sets up the u and uTimes arrays + integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt + integer(intKi) :: i + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'RotCalcOutput' +! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + !............................................................................................................................... + ! Place the selected output channels into the WriteOutput(:) array with the proper sign: + !............................................................................................................................... + + do i = 1,p%NumOuts ! Loop through all selected output channels + y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) + end do ! i - All selected output channels + + end if + + if (p%BldNd_TotNumOuts > 0) then + y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi + + ! Now we need to populate the blade node outputs here + if (p%NumBlades > 0) then + 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + end if + + +end subroutine RotWriteOutputs +!---------------------------------------------------------------------------------------------------------------------------------- subroutine AD_CavtCrit(u, p, m, errStat, errMsg) - TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters - TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - !! nectivity information does not have to be recalculated) + TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at time t + TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters + 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 - integer :: i,j - real(ReKi) :: SigmaCavitCrit, SigmaCavit + + ! Local variables + integer :: i, j + integer(intKi) :: iR, iW + real(ReKi) :: SigmaCavitCrit, SigmaCavit + real(ReKi) :: Vreltemp + real(ReKi) :: Cpmintemp errStat = ErrID_None errMsg = '' - if ( p%CavitCheck ) then ! Calculate the cavitation number for the airfoil at the node in quesiton, and compare to the critical cavitation number based on the vapour pressure and submerged depth - do j = 1,p%numBlades ! Loop through all blades - do i = 1,p%NumBlNds ! Loop through all nodes + do iR = 1,size(p%rotors) + if ( p%rotors(iR)%CavitCheck ) then ! Calculate the cavitation number for the airfoil at the node in quesiton, and compare to the critical cavitation number based on the vapour pressure and submerged depth + do j = 1,p%rotors(iR)%numBlades ! Loop through all blades + do i = 1,p%rotors(iR)%NumBlNds ! Loop through all nodes - if ( EqualRealNos( m%BEMT_y%Vrel(i,j), 0.0_ReKi ) ) call SetErrStat( ErrID_Fatal, 'Vrel cannot be zero to do a cavitation check', ErrStat, ErrMsg, 'AD_CavtCrit') - if (ErrStat >= AbortErrLev) return + if ( p%WakeMod == WakeMod_BEMT .or. p%WakeMod == WakeMod_DBEMT ) 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 + iW = p%FVW%Bld2Wings(iR,j) + Vreltemp = m%FVW%W(iW)%BN_Vrel(i) + Cpmintemp = m%FVW%W(iW)%BN_Cpmin(i) + end if + + if ( EqualRealNos( Vreltemp, 0.0_ReKi ) ) call SetErrStat( ErrID_Fatal, 'Vrel cannot be zero to do a cavitation check', ErrStat, ErrMsg, 'AD_CavtCrit' ) + if ( ErrStat >= AbortErrLev ) return - SigmaCavit= -1* m%BEMT_y%Cpmin(i,j) ! Local cavitation number on node j - SigmaCavitCrit= ( ( p%Patm + ( p%Gravity * (p%WtrDpth - ( u%HubMotion%Position(3,1)+u%HubMotion%TranslationDisp(3,1) ) - ( u%BladeMotion(j)%Position(3,i) + u%BladeMotion(j)%TranslationDisp(3,i) - u%HubMotion%Position(3,1))) * p%airDens) - p%Pvap ) / ( 0.5_ReKi * p%airDens * m%BEMT_y%Vrel(i,j)**2)) ! Critical value of Sigma, cavitation occurs if local cavitation number is greater than this + SigmaCavit = -1 * Cpmintemp ! Local cavitation number on node j + SigmaCavitCrit = ( p%rotors(iR)%Patm + ( p%rotors(iR)%Gravity * ( p%rotors(iR)%WtrDpth - ( u%rotors(iR)%BladeMotion(j)%Position(3,i) + u%rotors(iR)%BladeMotion(j)%TranslationDisp(3,i) ) ) * p%rotors(iR)%airDens ) - p%rotors(iR)%Pvap ) / ( 0.5_ReKi * p%rotors(iR)%airDens * Vreltemp**2 ) ! Critical value of Sigma, cavitation occurs if local cavitation number is greater than this - if ( (SigmaCavitCrit < SigmaCavit) .and. (.not. (m%CavitWarnSet(i,j)) ) ) then - call WrScr( NewLine//'Cavitation occurred at blade '//trim(num2lstr(j))//' and node '//trim(num2lstr(i))//'.' ) - m%CavitWarnSet(i,j) = .true. + if ( ( SigmaCavitCrit < SigmaCavit ) .and. ( .not. ( m%rotors(iR)%CavitWarnSet(i,j) ) ) ) then + call WrScr( NewLine//'Cavitation occurred at blade '//trim(num2lstr(j))//' and node '//trim(num2lstr(i))//'.' ) + m%rotors(iR)%CavitWarnSet(i,j) = .true. end if - m%SigmaCavit(i,j)= SigmaCavit - m%SigmaCavitCrit(i,j)=SigmaCavitCrit + m%rotors(iR)%SigmaCavit(i,j) = SigmaCavit + m%rotors(iR)%SigmaCavitCrit(i,j) = SigmaCavitCrit - end do ! p%NumBlNds - end do ! p%numBlades - end if ! Cavitation check + end do ! p%NumBlNds + end do ! p%numBlades + end if ! Cavitation check + end do ! p%numRotors end subroutine AD_CavtCrit !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for solving for the residual of the constraint state equations -subroutine AD_CalcConstrStateResidual( Time, u, p, p_AD, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) +subroutine AD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time (possibly a guess) @@ -1553,12 +1624,12 @@ subroutine AD_CalcConstrStateResidual( Time, u, p, p_AD, x, xd, z, OtherState, m do iR=1, size(p%rotors) - call RotCalcConstrStateResidual( Time, u%rotors(iR), p%rotors(iR), p_AD, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), m%rotors(iR), z_residual%rotors(iR), ErrStat, ErrMsg ) + 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 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 ) !.................................................................................................................................. @@ -1579,7 +1650,6 @@ subroutine RotCalcConstrStateResidual( Time, u, p, p_AD, x, xd, z, OtherState, m ! Local variables integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: iR ! rotor index integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'RotCalcConstrStateResidual' @@ -1622,7 +1692,6 @@ subroutine RotCalcContStateDeriv( t, u, p, p_AD, x, xd, z, OtherState, m, dxdt, CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: iR ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(*), PARAMETER :: RoutineName = 'RotCalcContStateDeriv' @@ -1721,7 +1790,6 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) ! local variables 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) @@ -1733,21 +1801,22 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) integer(intKi) :: j ! loop counter for nodes integer(intKi) :: k ! loop counter for blades - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 +! integer(intKi) :: ErrStat2 +! character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SetInputsForBEMT' ! note ErrStat and ErrMsg are set in GeomWithoutSweepPitchTwist: ! Get disk average values and orientations - call DiskAvgValues(p, u, m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) - call GeomWithoutSweepPitchTwist(p,u,m,thetaBladeNds,ErrStat,ErrMsg) + 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 GeomWithoutSweepPitchTwist(p,u,x_hat_disk,m,thetaBladeNds,ErrStat,ErrMsg) if (ErrStat >= AbortErrLev) return ! Velocity in disk normal m%BEMT_u(indx)%Un_disk = m%V_dot_x - ! "Angular velocity of rotor" rad/s + + ! "Angular velocity of rotor" rad/s m%BEMT_u(indx)%omega = dot_product( u%HubMotion%RotationVel(:,1), x_hat_disk ) ! "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 @@ -1781,13 +1850,6 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) m%BEMT_u(indx)%Vx(j,k) = dot_product( tmp, x_hat ) ! 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, y_hat ) ! tangential component (tangential to the plane, not chord) of the inflow velocity of the jth node in the kth blade - - !jmj says omega_z and PitchRate are the same things - ! inputs for DBEMT (DBEMT_Mod == DBEMT_cont_tauConst) - if (allocated(m%BEMT_u(indx)%Vx_elast_dot)) then - m%BEMT_u(indx)%Vx_elast_dot(j,k) = dot_product( u%BladeMotion(k)%TranslationAcc(:,j), x_hat ) ! 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_elast_dot(j,k) = dot_product( u%BladeMotion(k)%TranslationAcc(:,j), y_hat ) ! tangential component (tangential to the plane, not chord) of the inflow velocity of the jth node in the kth blade - end if ! inputs for CUA (and CDBEMT): m%BEMT_u(indx)%omega_z(j,k) = dot_product( u%BladeMotion(k)%RotationVel( :,j), m%WithoutSweepPitchTwist(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade @@ -1837,9 +1899,9 @@ subroutine DiskAvgValues(p, u, m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) type(RotInputType), intent(in ) :: u !< AD Inputs at Time type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables real(R8Ki), intent( out) :: x_hat_disk(3) - real(R8Ki), intent( out) :: y_hat_disk(3) - real(R8Ki), intent( out) :: z_hat_disk(3) - real(R8Ki), intent( out) :: Azimuth(p%NumBlades) + real(R8Ki), optional, intent( out) :: y_hat_disk(3) + real(R8Ki), optional, intent( out) :: z_hat_disk(3) + real(R8Ki), optional, intent( out) :: Azimuth(p%NumBlades) real(ReKi) :: z_hat(3) real(ReKi) :: tmp(3) real(ReKi) :: tmp_sz, tmp_sz_y @@ -1860,32 +1922,88 @@ subroutine DiskAvgValues(p, u, m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) x_hat_disk = u%HubMotion%Orientation(1,:,1) !actually also x_hat_hub m%V_dot_x = dot_product( m%V_diskAvg, x_hat_disk ) - tmp = m%V_dot_x * x_hat_disk - m%V_diskAvg - tmp_sz = TwoNorm(tmp) - if ( EqualRealNos( tmp_sz, 0.0_ReKi ) ) then - y_hat_disk = u%HubMotion%Orientation(2,:,1) - z_hat_disk = u%HubMotion%Orientation(3,:,1) - else - y_hat_disk = tmp / tmp_sz - z_hat_disk = cross_product( m%V_diskAvg, x_hat_disk ) / tmp_sz - end if - - ! "Azimuth angle" rad - do k=1,p%NumBlades - z_hat = u%BladeRootMotion(k)%Orientation(3,:,1) - tmp_sz_y = -1.0*dot_product(z_hat,y_hat_disk) - tmp_sz = dot_product(z_hat,z_hat_disk) - if ( EqualRealNos(tmp_sz_y,0.0_ReKi) .and. EqualRealNos(tmp_sz,0.0_ReKi) ) then - Azimuth(k) = 0.0_ReKi + + + if (present(y_hat_disk)) then + + tmp = m%V_dot_x * x_hat_disk - m%V_diskAvg + tmp_sz = TwoNorm(tmp) + if ( EqualRealNos( tmp_sz, 0.0_ReKi ) ) then + y_hat_disk = u%HubMotion%Orientation(2,:,1) + z_hat_disk = u%HubMotion%Orientation(3,:,1) else - Azimuth(k) = atan2( tmp_sz_y, tmp_sz ) - end if - end do + y_hat_disk = tmp / tmp_sz + z_hat_disk = cross_product( m%V_diskAvg, x_hat_disk ) / tmp_sz + end if + + ! "Azimuth angle" rad + do k=1,p%NumBlades + z_hat = u%BladeRootMotion(k)%Orientation(3,:,1) + tmp_sz_y = -1.0*dot_product(z_hat,y_hat_disk) + tmp_sz = dot_product(z_hat,z_hat_disk) + if ( EqualRealNos(tmp_sz_y,0.0_ReKi) .and. EqualRealNos(tmp_sz,0.0_ReKi) ) then + Azimuth(k) = 0.0_ReKi + else + Azimuth(k) = atan2( tmp_sz_y, tmp_sz ) + end if + end do + + end if + end subroutine DiskAvgValues !---------------------------------------------------------------------------------------------------------------------------------- -subroutine GeomWithoutSweepPitchTwist(p,u,m,thetaBladeNds,ErrStat,ErrMsg) +subroutine Calculate_MeshOrientation_Rel2Hub(Mesh1, HubMotion, x_hat_disk, orientationAnnulus, elemPosRelToHub_save, elemPosRotorProj_save) + TYPE(MeshType), intent(in) :: Mesh1 !< either BladeMotion or BladeRootMotion mesh + TYPE(MeshType), intent(in) :: HubMotion !< HubMotion mesh + REAL(R8Ki), intent(in) :: x_hat_disk(3) + REAL(ReKi), intent(out) :: orientationAnnulus(3,3,Mesh1%NNodes) + real(R8Ki), optional, intent(out) :: elemPosRelToHub_save( 3,Mesh1%NNodes) + real(R8Ki), optional, intent(out) :: elemPosRotorProj_save(3,Mesh1%NNodes) + + real(R8Ki) :: x_hat_annulus(3) ! rotor normal unit vector (local rotor reference frame) + real(R8Ki) :: y_hat_annulus(3) ! annulus tangent unit vector (local rotor reference frame) + real(R8Ki) :: z_hat_annulus(3) ! annulus radial unit vector (local rotor reference frame) +! real(R8Ki) :: chordVec(3) + + integer(intKi) :: j ! loop counter for nodes + + REAL(R8Ki) :: HubAbsPosition(3) + real(R8Ki) :: elemPosRelToHub(3) ! local copies of + real(R8Ki) :: elemPosRotorProj(3) ! local copies of + + + HubAbsPosition = HubMotion%Position(:,1) + HubMotion%TranslationDisp(:,1) + + !.......................... + ! orientation + !.......................... + + do j=1,Mesh1%NNodes + !chordVec(:,j) = Mesh1%orientation(:,2,j) + ! Project element position onto the rotor plane + elemPosRelToHub = Mesh1%Position(:,j) + Mesh1%TranslationDisp(:,j) - HubAbsPosition ! + 0.00_ReKi*chordVec(:,j)*p%BEMT%chord(j,k) + elemPosRotorProj = elemPosRelToHub - x_hat_disk * dot_product( x_hat_disk, elemPosRelToHub ) + + ! Get unit vectors of the local annulus reference frame + z_hat_annulus = elemPosRotorProj / TwoNorm( elemPosRotorProj ) + x_hat_annulus = x_hat_disk + y_hat_annulus = cross_product( z_hat_annulus, x_hat_annulus ) + + ! Form a orientation matrix for the annulus reference frame + orientationAnnulus(1,:,j) = x_hat_annulus + orientationAnnulus(2,:,j) = y_hat_annulus + orientationAnnulus(3,:,j) = z_hat_annulus + + if (present(elemPosRelToHub_save) ) elemPosRelToHub_save( :,j) = elemPosRelToHub + if (present(elemPosRotorProj_save)) elemPosRotorProj_save(:,j) = elemPosRotorProj + end do + +end subroutine Calculate_MeshOrientation_Rel2Hub +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine GeomWithoutSweepPitchTwist(p,u,x_hat_disk,m,thetaBladeNds,ErrStat,ErrMsg) type(RotParameterType), intent(in ) :: p !< AD parameters type(RotInputType), intent(in ) :: u !< AD Inputs at Time + real(R8Ki), intent(in ) :: x_hat_disk(3) type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables real(R8Ki), intent( out) :: thetaBladeNds(p%NumBlNds,p%NumBlades) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation @@ -1904,6 +2022,7 @@ subroutine GeomWithoutSweepPitchTwist(p,u,m,thetaBladeNds,ErrStat,ErrMsg) ErrMsg = "" if (p%AeroProjMod==0) then + ! theta, "Twist angle (includes all sources of twist)" rad ! Vx, "Local axial velocity at node" m/s ! Vy, "Local tangential velocity at node" m/s @@ -1933,26 +2052,47 @@ subroutine GeomWithoutSweepPitchTwist(p,u,m,thetaBladeNds,ErrStat,ErrMsg) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) theta = EulerExtract( orientation ) !root(k)WithoutPitch_theta(j)_blade(k) - thetaBladeNds(j,k) = -theta(3) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade - + m%Curve( j,k) = theta(2) ! save value for possible output later + thetaBladeNds(j,k) = -theta(3) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade theta(1) = 0.0_ReKi theta(3) = 0.0_ReKi - m%Curve(j,k) = theta(2) ! save value for possible output later m%WithoutSweepPitchTwist(:,:,j,k) = matmul( EulerConstruct( theta ), orientation_nopitch ) ! WithoutSweepPitch+Twist_theta(j)_Blade(k) end do !j=nodes end do !k=blades + else if (p%AeroProjMod==1) then - ! Generic blade, we don't assume where the axes are, and we keep the default orientation + do k=1,p%NumBlades - m%hub_theta_x_root(k) = 0.0_ReKi ! ill-defined, TODO + call LAPACK_gemm( 'n', 't', 1.0_R8Ki, u%BladeRootMotion(k)%Orientation(:,:,1), u%HubMotion%Orientation(:,:,1), 0.0_R8Ki, orientation, errStat2, errMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + theta = EulerExtract( orientation ) !hub_theta_root(k) + if (k<=3) then + m%AllOuts( BPitch( k) ) = -theta(3)*R2D ! save this value of pitch for potential output + endif + theta(3) = 0.0_ReKi + m%hub_theta_x_root(k) = theta(1) ! save this value for FAST.Farm + end do + + + do k=1,p%NumBlades + call Calculate_MeshOrientation_Rel2Hub(u%BladeMotion(k), u%HubMotion, x_hat_disk, m%WithoutSweepPitchTwist(:,:,:,k)) + do j=1,p%NumBlNds - thetaBladeNds(j,k) = 0.0_ReKi ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade - m%Curve(j,k) = 0.0_ReKi ! ill-defined, TODO m%WithoutSweepPitchTwist(:,:,j,k) = u%BladeMotion(k)%Orientation(:,:,j) enddo enddo + + do k=1,p%NumBlades + do j=1,p%NumBlNds + orientation = matmul( u%BladeMotion(k)%Orientation(:,:,j), transpose( m%WithoutSweepPitchTwist(:,:,j,k) ) ) + theta = EulerExtract( orientation ) + m%Curve( j,k) = theta(2) + thetaBladeNds(j,k) = -theta(3) + enddo + enddo + else ErrStat = ErrID_Fatal ErrMsg ='GeomWithoutSweepPitchTwist: AeroProjMod not supported '//trim(num2lstr(p%AeroProjMod)) @@ -1969,26 +2109,21 @@ subroutine SetInputsForFVW(p, u, m, errStat, errMsg) character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None real(R8Ki) :: x_hat_disk(3) - real(R8Ki) :: y_hat_disk(3) - real(R8Ki) :: z_hat_disk(3) real(R8Ki), allocatable :: thetaBladeNds(:,:) - real(R8Ki), allocatable :: Azimuth(:) integer(intKi) :: tIndx integer(intKi) :: iR ! Loop on rotors integer(intKi) :: j, k ! loop counter for blades character(*), parameter :: RoutineName = 'SetInputsForFVW' integer :: iW - integer :: nWings do tIndx=1,size(u) do iR =1, size(p%rotors) allocate(thetaBladeNds(p%rotors(iR)%NumBlNds, p%rotors(iR)%NumBlades)) - allocate(azimuth(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(tIndx)%rotors(iR), m%rotors(iR), x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) - call GeomWithoutSweepPitchTwist(p%rotors(iR),u(tIndx)%rotors(iR), m%rotors(iR), thetaBladeNds,ErrStat,ErrMsg) + call DiskAvgValues(p%rotors(iR), u(tIndx)%rotors(iR), m%rotors(iR), x_hat_disk) ! also sets m%V_diskAvg and m%V_dot_x + call GeomWithoutSweepPitchTwist(p%rotors(iR),u(tIndx)%rotors(iR), x_hat_disk, m%rotors(iR), thetaBladeNds,ErrStat,ErrMsg) if (ErrStat >= AbortErrLev) return ! Rather than use a meshcopy, we will just copy what we need to the WingsMesh @@ -2016,7 +2151,6 @@ subroutine SetInputsForFVW(p, u, m, errStat, errMsg) end do !j=nodes enddo ! k blades if (allocated(thetaBladeNds)) deallocate(thetaBladeNds) - if (allocated(azimuth)) deallocate(azimuth) enddo ! iR, rotors if (ALLOCATED(m%FVW_u(tIndx)%V_wind)) then @@ -2079,8 +2213,6 @@ subroutine SetInputsForAA(p, u, m, errStat, errMsg) end do end do end subroutine SetInputsForAA -!---------------------------------------------------------------------------------------------------------------------------------- - !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine converts outputs from BEMT (stored in m%BEMT_y) into values on the AeroDyn BladeLoad output mesh. subroutine SetOutputsFromBEMT(p, m, y ) @@ -2088,8 +2220,6 @@ subroutine SetOutputsFromBEMT(p, m, y ) type(RotParameterType), intent(in ) :: p !< AD parameters type(RotOutputType), intent(inout) :: y !< AD outputs type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables - !type(BEMT_OutputType), intent(in ) :: BEMT_y ! BEMT outputs - !real(ReKi), intent(in ) :: WithoutSweepPitchTwist(:,:,:,:) ! modified orientation matrix integer(intKi) :: j ! loop counter for nodes integer(intKi) :: k ! loop counter for blades @@ -2157,7 +2287,7 @@ subroutine SetOutputsFromFVW(t, u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) type(AFI_OutputType) :: AFI_interp ! Resulting values from lookup table real(ReKi) :: UrelWind_s(3) ! Relative wind (wind+str) in section coords real(ReKi) :: Cx, Cy - real(ReKi) :: Cl_Static, Cd_Static, Cm_Static + real(ReKi) :: Cl_Static, Cd_Static, Cm_Static, Cpmin real(ReKi) :: Cl_dyn, Cd_dyn, Cm_dyn type(UA_InputType), pointer :: u_UA ! Alias to shorten notations integer(IntKi), parameter :: InputIndex=1 ! we will always use values at t in this routine @@ -2191,6 +2321,7 @@ subroutine SetOutputsFromFVW(t, u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) Cl_Static = AFI_interp%Cl Cd_Static = AFI_interp%Cd Cm_Static = AFI_interp%Cm + Cpmin = AFI_interp%Cpmin ! Set dynamic to the (will be same as static if UA_Flag is false) Cl_dyn = AFI_interp%Cl @@ -2245,6 +2376,7 @@ subroutine SetOutputsFromFVW(t, u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) m%FVW%W(iW)%BN_Cl_Static(j) = Cl_Static m%FVW%W(iW)%BN_Cd_Static(j) = Cd_Static m%FVW%W(iW)%BN_Cm_Static(j) = Cm_Static + m%FVW%W(iW)%BN_Cpmin(j) = Cpmin m%FVW%W(iW)%BN_Cl(j) = Cl_dyn m%FVW%W(iW)%BN_Cd(j) = Cd_dyn m%FVW%W(iW)%BN_Cm(j) = Cm_dyn @@ -2263,7 +2395,7 @@ subroutine SetOutputsFromFVW(t, u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) end subroutine SetOutputsFromFVW !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine validates the inputs from the AeroDyn input files. +!> This routine validates the number of blades on each rotor. SUBROUTINE ValidateNumBlades( NumBl, ErrStat, ErrMsg ) integer(IntKi), intent(in) :: NumBl !< Number of blades integer(IntKi), intent(out) :: ErrStat !< Error status @@ -2281,7 +2413,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 + integer(IntKi), intent(in) :: NumBl(:) !< Number of blades: size(NumBl) = number of rotors integer(IntKi), intent(out) :: ErrStat !< Error status character(*), intent(out) :: ErrMsg !< Error message @@ -2295,6 +2427,17 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) 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 ) +! return ! return early because InputFileData%BladeProps may not be allocated properly otherwise... +! else +! if (NumBl(iR) > AD_MaxBl_Out .and. InitInp%Linearize) then +! call SetErrStat( ErrID_Fatal, 'Number of blades must be no larger than '//trim(num2lstr(AD_MaxBl_Out))//' for linearizaton analysis.', ErrStat, ErrMsg, RoutineName ) +! return ! return early because InputFileData%BladeProps may not be allocated properly otherwise... +! end if +! end if +! 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 @@ -2486,21 +2629,17 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) !.................. if (InitInp%Linearize) then if (InputFileData%AFAeroMod /= AFAeroMod_Steady) then -!bjj: REMOVE when linearization has been tested - call SetErrStat( ErrID_Fatal, 'Steady blade airfoil aerodynamics must be used for linearization. Set AFAeroMod=1.', ErrStat, ErrMsg, RoutineName ) - !if (InputFileData%UAMod /= UA_HGM) then - ! call SetErrStat( ErrID_Fatal, 'When AFAeroMod=2, UAMod must be 4 for linearization. Set AFAeroMod=1 or UAMod=4.', ErrStat, ErrMsg, RoutineName ) - !end if + 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 end if - if (InputFileData%WakeMod == WakeMod_FVW) then + 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 -!bjj: when linearization has been tested - call SetErrStat( ErrID_Fatal, 'DBEMT cannot currently be used for linearization. Set WakeMod=0 or WakeMod=1.', ErrStat, ErrMsg, RoutineName ) - !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 + 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 end if end if @@ -2701,6 +2840,7 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x real(ReKi) :: tmp(3), tmp_sz_y, tmp_sz real(ReKi) :: y_hat_disk(3) real(ReKi) :: z_hat_disk(3) + real(ReKi) :: position(3) real(ReKi) :: rMax real(ReKi) :: frac integer(IntKi) :: ErrStat2 @@ -2739,7 +2879,7 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x call AllocAry(InitInp%zLocal,InitInp%numBladeNodes,InitInp%numBlades,'zLocal', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) 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) @@ -2749,7 +2889,7 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x end if - ! Compute zLocal, zHub, zTip, rLocal, rMax + ! Compute zLocal, zHub, zTip, rLocal, rMax, rTipFix rMax = 0.0_ReKi do k=1,p%numBlades @@ -2776,7 +2916,25 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x tmp_sz = dot_product( tmp, z_hat_disk )**2 InitInp%rLocal(j,k) = sqrt( tmp_sz + tmp_sz_y ) rMax = max(rMax, InitInp%rLocal(j,k)) - end do !j=nodes + end do !j=nodes + + + !......... + ! compute fixed rLocal at tip node (without prebend) for Bladed-like calculations: + !......... + tmp(1) = 0.0_ReKi !RotInputFile%BladeProps(k)%BlCrvAC(p%NumBlNds) + tmp(2) = 0.0_ReKi !RotInputFile%BladeProps(k)%BlSwpAC(p%NumBlNds) + tmp(3) = RotInputFileData%BladeProps(k)%BlSpn(p%NumBlNds) + position = u_AD%BladeRootMotion(k)%Position(:,1) + matmul(tmp,u_AD%BladeRootMotion(k)%RefOrientation(:,:,1)) ! note that because positionL is a 1-D array, we're doing the transpose of matmul(transpose(u%BladeRootMotion(k)%RefOrientation),positionL) + + ! position of the coned tip node in the kth blade relative to the hub: + tmp = position - u_AD%HubMotion%Position(:,1) + + ! local radius (normalized distance from rotor centerline) + tmp_sz_y = dot_product( tmp, y_hat_disk )**2 + tmp_sz = dot_product( tmp, z_hat_disk )**2 + InitInp%rTipFix(k) = sqrt( tmp_sz + tmp_sz_y ) + end do !k=blades @@ -3112,15 +3270,11 @@ SUBROUTINE TwrInfl( p, u, m, ErrStat, ErrMsg ) real(ReKi) :: BladeNodePosition(3) ! local blade node position - - real(ReKi) :: u_TwrShadow ! axial velocity deficit fraction from tower shadow - real(ReKi) :: u_TwrPotent ! axial velocity deficit fraction from tower potential flow - real(ReKi) :: v_TwrPotent ! transverse velocity deficit fraction from tower potential flow - - real(ReKi) :: denom ! denominator - real(ReKi) :: exponential ! exponential term real(ReKi) :: v(3) ! temp vector + logical :: FirstWarn_TowerStrike + logical :: DisturbInflow + integer(IntKi) :: j, k ! loop counters for elements, blades integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -3130,6 +3284,7 @@ SUBROUTINE TwrInfl( p, u, m, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" + FirstWarn_TowerStrike = .true. ! these models are valid for only small tower deflections; check for potential division-by-zero errors: call CheckTwrInfl( u, ErrStat2, ErrMsg2 ) @@ -3144,70 +3299,17 @@ 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), ErrStat2, ErrMsg2) + 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (.not. FirstWarn_TowerStrike) call SetErrStat(ErrID_Fatal, "Tower strike.", ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) return - - - ! calculate tower influence: - if ( abs(zbar) < 1.0_ReKi .and. p%TwrPotent /= TwrPotent_none ) then - if ( p%TwrPotent == TwrPotent_baseline ) then - - denom = (xbar**2 + ybar**2)**2 - - if (equalRealNos(denom,0.0_ReKi)) then - u_TwrPotent = 0.0_ReKi - v_TwrPotent = 0.0_ReKi - else - u_TwrPotent = ( -1.0*xbar**2 + ybar**2 ) / denom - v_TwrPotent = ( -2.0*xbar * ybar ) / denom - end if - - elseif (p%TwrPotent == TwrPotent_Bak) then - - xbar = xbar + 0.1 - - denom = (xbar**2 + ybar**2)**2 - if (equalRealNos(denom,0.0_ReKi)) then - u_TwrPotent = 0.0_ReKi - v_TwrPotent = 0.0_ReKi - else - u_TwrPotent = ( -1.0*xbar**2 + ybar**2 ) / denom - v_TwrPotent = ( -2.0*xbar * ybar ) / denom - - denom = TwoPi*(xbar**2 + ybar**2) - u_TwrPotent = u_TwrPotent + TwrCd*xbar / denom - v_TwrPotent = v_TwrPotent + TwrCd*ybar / denom - end if - - end if + + 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 ) else - u_TwrPotent = 0.0_ReKi - v_TwrPotent = 0.0_ReKi + m%DisturbedInflow(:,j,k) = u%InflowOnBlade(:,j,k) end if - - u_TwrShadow = 0.0_ReKi - select case (p%TwrShadow) - case (TwrShadow_Powles) - if ( xbar > 0.0_ReKi .and. abs(zbar) < 1.0_ReKi) then - denom = sqrt( sqrt( xbar**2 + ybar**2 ) ) - if ( abs(ybar) < denom ) then - u_TwrShadow = -TwrCd / denom * cos( PiBy2*ybar / denom )**2 - end if - end if - case (TwrShadow_Eames) - if ( xbar > 0.0_ReKi .and. abs(zbar) < 1.0_ReKi) then - exponential = ( ybar / (TwrTI * xbar) )**2 - denom = TwrTI * xbar * sqrt( TwoPi ) - u_TwrShadow = -TwrCd / denom * exp ( -0.5_ReKi * exponential ) - end if - end select - - v(1) = (u_TwrPotent + u_TwrShadow)*W_tower - v(2) = v_TwrPotent*W_tower - v(3) = 0.0_ReKi - - m%DisturbedInflow(:,j,k) = u%InflowOnBlade(:,j,k) + matmul( theta_tower_trans, v ) end do !j=NumBlNds end do ! NumBlades @@ -3235,109 +3337,125 @@ SUBROUTINE TwrInflArray( p, u, m, Positions, Inflow, ErrStat, ErrMsg ) real(ReKi) :: TwrTI ! local tower TI (for Eames tower shadow model) real(ReKi) :: W_tower ! local relative wind speed normal to the tower real(ReKi) :: Pos(3) ! current point - real(ReKi) :: u_TwrShadow ! axial velocity deficit fraction from tower shadow - real(ReKi) :: u_TwrPotent ! axial velocity deficit fraction from tower potential flow - real(ReKi) :: v_TwrPotent ! transverse velocity deficit fraction from tower potential flow - real(ReKi) :: denom ! denominator - real(ReKi) :: exponential ! exponential term real(ReKi) :: v(3) ! temp vector integer(IntKi) :: i ! loop counters for points real(ReKi) :: TwrClrnc ! local tower clearance - real(ReKi) :: r_TowerBlade(3) ! distance vector from tower to blade - real(ReKi) :: TwrDiam ! local tower diameter - logical :: found + logical :: FirstWarn_TowerStrike + logical :: DisturbInflow integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'TwrInflArray' ErrStat = ErrID_None ErrMsg = "" + + + FirstWarn_TowerStrike = .false. ! we aren't going to end due to an assumed "tower-strike" + ! these models are valid for only small tower deflections; check for potential division-by-zero errors: call CheckTwrInfl( u, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ); if (ErrStat >= AbortErrLev) return !$OMP PARALLEL default(shared) - !$OMP do private(i,Pos,r_TowerBlade,theta_tower_trans,W_tower,xbar,ybar,zbar,TwrCd,TwrTI,TwrClrnc,TwrDiam,found,denom,exponential,u_TwrPotent,v_TwrPotent,u_TwrShadow,v) schedule(runtime) + !$OMP do private(i,Pos,theta_tower_trans,W_tower,xbar,ybar,zbar,TwrCd,TwrTI,TwrClrnc,FirstWarn_TowerStrike,DisturbInflow,v) schedule(runtime) do i = 1, size(Positions,2) Pos=Positions(1:3,i) ! 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: - ! option 1: nearest line2 element - call TwrInfl_NearestLine2Element(p, u, Pos, 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, Pos, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrDiam) + call getLocalTowerProps(p, u, 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) + Inflow(1:3,i) = Inflow(1:3,i) + matmul( theta_tower_trans, v ) end if - TwrClrnc = TwoNorm(r_TowerBlade) - 0.5_ReKi*TwrDiam + + enddo ! loop on points + !$OMP END DO + !$OMP END PARALLEL +END SUBROUTINE TwrInflArray +!---------------------------------------------------------------------------------------------------------------------------------- +FUNCTION CalculateTowerInfluence(p, xbar_in, ybar, zbar, W_tower, TwrCd, TwrTI) RESULT(v) - if ( TwrClrnc>20*TwrDiam) then - ! Far away, we skip the computation and keep undisturbed inflow - elseif ( TwrClrnc<=0.01_ReKi*TwrDiam) then - ! Inside the tower, or very close, (will happen for vortex elements) we keep undisturbed inflow - ! We don't want to reach the stagnation points - else - ! calculate tower influence: - if ( abs(zbar) < 1.0_ReKi .and. p%TwrPotent /= TwrPotent_none ) then - - if ( p%TwrPotent == TwrPotent_baseline ) then - denom = (xbar**2 + ybar**2)**2 - u_TwrPotent = ( -1.0*xbar**2 + ybar**2 ) / denom - v_TwrPotent = ( -2.0*xbar * ybar ) / denom - - elseif (p%TwrPotent == TwrPotent_Bak) then - xbar = xbar + 0.1 - denom = (xbar**2 + ybar**2)**2 - u_TwrPotent = ( -1.0*xbar**2 + ybar**2 ) / denom - v_TwrPotent = ( -2.0*xbar * ybar ) / denom - denom = TwoPi*(xbar**2 + ybar**2) - u_TwrPotent = u_TwrPotent + TwrCd*xbar / denom - v_TwrPotent = v_TwrPotent + TwrCd*ybar / denom + 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) :: 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 + real(ReKi), intent(in) :: TwrCd ! local tower drag coefficient + real(ReKi), intent(in) :: TwrTI ! local tower TI (for Eames tower shadow model) + real(ReKi) :: v(3) ! modified velocity vector + + real(ReKi) :: denom ! denominator + real(ReKi) :: exponential ! exponential term + real(ReKi) :: xbar ! potentially modified version of xbar_in + real(ReKi) :: u_TwrShadow ! axial velocity deficit fraction from tower shadow + real(ReKi) :: u_TwrPotent ! axial velocity deficit fraction from tower potential flow + real(ReKi) :: v_TwrPotent ! transverse velocity deficit fraction from tower potential flow + + + u_TwrShadow = 0.0_ReKi + u_TwrPotent = 0.0_ReKi + v_TwrPotent = 0.0_ReKi + xbar = xbar_in + + ! calculate tower influence: + if ( abs(zbar) < 1.0_ReKi .and. p%TwrPotent /= TwrPotent_none ) then + + if ( p%TwrPotent == TwrPotent_baseline ) then + denom = (xbar**2 + ybar**2)**2 + u_TwrPotent = ( -1.0*xbar**2 + ybar**2 ) / denom + v_TwrPotent = ( -2.0*xbar * ybar ) / denom + + elseif (p%TwrPotent == TwrPotent_Bak) then + xbar = xbar + 0.1 + denom = (xbar**2 + ybar**2)**2 + u_TwrPotent = ( -1.0*xbar**2 + ybar**2 ) / denom + v_TwrPotent = ( -2.0*xbar * ybar ) / denom + denom = TwoPi*(xbar**2 + ybar**2) + u_TwrPotent = u_TwrPotent + TwrCd*xbar / denom + v_TwrPotent = v_TwrPotent + TwrCd*ybar / denom + end if + end if + + select case (p%TwrShadow) + case (TwrShadow_Powles) + if ( xbar > 0.0_ReKi .and. abs(zbar) < 1.0_ReKi) then + denom = sqrt( sqrt( xbar**2 + ybar**2 ) ) + if ( abs(ybar) < denom ) then + u_TwrShadow = -TwrCd / denom * cos( PiBy2*ybar / denom )**2 end if - else - u_TwrPotent = 0.0_ReKi - v_TwrPotent = 0.0_ReKi end if + case (TwrShadow_Eames) + if ( xbar > 0.0_ReKi .and. abs(zbar) < 1.0_ReKi) then + exponential = ( ybar / (TwrTI * xbar) )**2 + denom = TwrTI * xbar * sqrt( TwoPi ) + u_TwrShadow = -TwrCd / denom * exp ( -0.5_ReKi * exponential ) + end if + end select + + ! We limit the deficit to avoid having too much flow reversal and accumulation of vorticity behind the tower + ! Limit to -0.5 the wind speed at the tower + u_TwrShadow =max(u_TwrShadow, -0.5_ReKi) - u_TwrShadow = 0.0_ReKi - select case (p%TwrShadow) - case (TwrShadow_Powles) - if ( xbar > 0.0_ReKi .and. abs(zbar) < 1.0_ReKi) then - denom = sqrt( sqrt( xbar**2 + ybar**2 ) ) - if ( abs(ybar) < denom ) then - u_TwrShadow = -TwrCd / denom * cos( PiBy2*ybar / denom )**2 - end if - end if - case (TwrShadow_Eames) - if ( xbar > 0.0_ReKi .and. abs(zbar) < 1.0_ReKi) then - exponential = ( ybar / (TwrTI * xbar) )**2 - denom = TwrTI * xbar * sqrt( TwoPi ) - u_TwrShadow = -TwrCd / denom * exp ( -0.5_ReKi * exponential ) - end if - ! We limit the deficit to avoid having too much flow reversal and accumulation of vorticity behind the tower - ! Limit to -0.5 the wind speed at the tower - u_TwrShadow =max(u_TwrShadow, -0.5) - end select - - v(1) = (u_TwrPotent + u_TwrShadow)*W_tower - v(2) = v_TwrPotent*W_tower - v(3) = 0.0_ReKi - Inflow(1:3,i) = Inflow(1:3,i) + matmul( theta_tower_trans, v ) - endif ! Check if point far away or in tower - enddo ! loop on points - !$OMP END DO - !$OMP END PARALLEL -END SUBROUTINE TwrInflArray + v(1) = (u_TwrPotent + u_TwrShadow)*W_tower + v(2) = v_TwrPotent*W_tower + v(3) = 0.0_ReKi + + +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, ErrStat, ErrMsg) +SUBROUTINE getLocalTowerProps(p, u, 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(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 + LOGICAL ,INTENT(INOUT) :: FirstWarn_TowerStrike !< Whether we should check and warn for a tower strike + LOGICAL ,INTENT( OUT) :: DisturbInflow !< Whether tower clearance is in the range of values where it should disturb the inflow REAL(ReKi) ,INTENT( OUT) :: W_tower !< local relative wind speed normal to the tower REAL(ReKi) ,INTENT( OUT) :: xbar !< local x^ component of r_TowerBlade normalized by tower radius REAL(ReKi) ,INTENT( OUT) :: ybar !< local y^ component of r_TowerBlade normalized by tower radius @@ -3372,11 +3490,31 @@ SUBROUTINE getLocalTowerProps(p, u, BladeNodePosition, theta_tower_trans, W_towe end if TwrClrnc = TwoNorm(r_TowerBlade) - 0.5_ReKi*TwrDiam - if ( TwrClrnc <= 0.0_ReKi ) then - call SetErrStat(ErrID_Fatal, "Tower strike.", ErrStat, ErrMsg, RoutineName) + + if (FirstWarn_TowerStrike) then + if ( TwrClrnc <= 0.0_ReKi ) then + !call SetErrStat(ErrID_Fatal, "Tower strike.", ErrStat, ErrMsg, RoutineName) + !call SetErrStat(ErrID_Severe, NewLine//NewLine//"** WARNING: Tower strike. ** This warning will not be repeated though the condition may persist."//NewLine//NewLine//, ErrStat, ErrMsg, RoutineName) + call WrScr( NewLine//NewLine//"** WARNING: Tower strike. ** This warning will not be repeated though the condition may persist."//NewLine//NewLine ) + FirstWarn_TowerStrike = .false. + end if end if + - + if ( TwrClrnc>20.0_ReKi*TwrDiam) then + ! Far away, we skip the computation and keep undisturbed inflow + DisturbInflow = .false. + elseif ( TwrClrnc<=0.01_ReKi*TwrDiam) then + ! Inside the tower, or very close, (will happen for vortex elements) we keep undisturbed inflow + ! We don't want to reach the stagnation points + DisturbInflow = .false. + !elseif ( TwrClrnc<= 0.0_ReKi) then + ! ! Tower strike + ! DisturbInflow = .false. + else + DisturbInflow = .true. + end if + END SUBROUTINE getLocalTowerProps !---------------------------------------------------------------------------------------------------------------------------------- !> Option 1: Find the nearest-neighbor line2 element of the tower mesh for which the blade line2-element node projects orthogonally onto @@ -3534,7 +3672,7 @@ SUBROUTINE TwrInfl_NearestPoint(p, u, BladeNodePosition, r_TowerBlade, theta_tow REAL(ReKi) ,INTENT( OUT) :: ybar !< local y^ component of r_TowerBlade normalized by tower radius REAL(ReKi) ,INTENT( OUT) :: zbar !< local z^ component of r_TowerBlade normalized by tower radius REAL(ReKi) ,INTENT( OUT) :: TwrCd !< local tower drag coefficient - REAL(ReKi) ,INTENT( OUT) :: TwrTI !< local tower TI (for Eeames tower shadow model) + REAL(ReKi) ,INTENT( OUT) :: TwrTI !< local tower TI (for Eames tower shadow model) REAL(ReKi) ,INTENT( OUT) :: TwrDiam !< local tower diameter ! local variables @@ -3682,14 +3820,14 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM 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), ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + 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) 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, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE Rot_JacobianPInput( t, u, 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 @@ -3705,6 +3843,8 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrSta !! 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 @@ -3832,7 +3972,7 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrSta 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 RotCalcOutput( t, u_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_p, m, ErrStat2, ErrMsg2 ) + 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 @@ -3855,12 +3995,12 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrSta 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 RotCalcOutput( t, u_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_m, m, ErrStat2, ErrMsg2 ) + 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 ! get central difference: - call Compute_dY( p, y_p, y_m, delta_p, delta_m, dYdu(:,i) ) + call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdu(:,i) ) end do @@ -3995,7 +4135,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), ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) + 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 ) END SUBROUTINE AD_JacobianPContState @@ -4003,7 +4143,7 @@ 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, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE RotJacobianPContState( t, u, 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 @@ -4019,6 +4159,8 @@ SUBROUTINE RotJacobianPContState( t, u, p, p_AD, x, xd, z, OtherState, y, m, Err !! available here so that mesh parameter information (i.e., !! connectivity) does not have to be recalculated for dYdx. 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) :: dYdx(:,:) !< Partial derivatives of output functions @@ -4124,7 +4266,7 @@ SUBROUTINE RotJacobianPContState( t, u, p, p_AD, x, xd, z, OtherState, y, m, Err ! 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, ErrStat2, ErrMsg2 ) + 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 @@ -4135,12 +4277,12 @@ SUBROUTINE RotJacobianPContState( t, u, p, p_AD, x, xd, z, OtherState, y, m, Err ! 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, ErrStat2, ErrMsg2 ) + 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 ! get central difference: - call Compute_dY( p, y_p, y_m, delta_p, delta_m, dYdx(:,i) ) + call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdx(:,i) ) end do @@ -4364,13 +4506,13 @@ 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), errStat, errMsg, dYdz, dXdz, dXddz, dZdz ) + 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 ) 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, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) +SUBROUTINE RotJacobianPConstrState( t, u, 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 @@ -4386,6 +4528,8 @@ SUBROUTINE RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, E !! 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 @@ -4492,7 +4636,7 @@ SUBROUTINE RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, E 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, ErrStat2, ErrMsg2 ) + 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 @@ -4500,12 +4644,12 @@ SUBROUTINE RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, E 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, ErrStat2, ErrMsg2 ) + 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 ! get central difference: - call Compute_dY( p, y_p, y_m, delta_p, delta_m, dYdz(:,i) ) + call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdz(:,i) ) ! put z_perturb back (for next iteration): @@ -4825,8 +4969,8 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, 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_dot) - x_op(index) = x%BEMT%DBEMT%element(i,j)%vind_dot(k) + do k=1,size(x%BEMT%DBEMT%element(i,j)%vind_1) + x_op(index) = x%BEMT%DBEMT%element(i,j)%vind_1(k) index = index + 1 end do end do @@ -4835,14 +4979,23 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, end if if (p%BEMT%UA%lin_nx>0) then - 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) + 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 - 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 end if @@ -4878,8 +5031,8 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, 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_dot) - dx_op(index) = dxdt%BEMT%DBEMT%element(i,j)%vind_dot(k) + do k=1,size(dxdt%BEMT%DBEMT%element(i,j)%vind_1) + dx_op(index) = dxdt%BEMT%DBEMT%element(i,j)%vind_1(k) index = index + 1 end do end do @@ -4888,14 +5041,23 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, end if if (p%BEMT%UA%lin_nx>0) then - 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) + 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 - 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) @@ -5398,15 +5560,17 @@ SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) 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 + InitOut%LinNames_x(k) = 'x1 '//trim(NodeTxt)//', rad' + k = k + 1 - InitOut%LinNames_x(k) = 'x2 '//trim(NodeTxt)//', rad' - k = k + 1 - - InitOut%LinNames_x(k) = 'x3 '//trim(NodeTxt)//', -' - k = k + 1 + 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 @@ -5575,17 +5739,23 @@ SUBROUTINE Perturb_x( p, n, perturb_sign, x, dx ) if (n <= p%BEMT%DBEMT%lin_nx) then - if (n <= p%BEMT%DBEMT%lin_nx/2) then ! x_p%BEMT%DBEMT%element(i,j)%vind, else x_p%BEMT%DBEMT%element(i,j)%vind_dot + if (n <= p%BEMT%DBEMT%lin_nx/2) then ! x_p%BEMT%DBEMT%element(i,j)%vind, else x_p%BEMT%DBEMT%element(i,j)%vind_1 call GetStateIndices( n, size(x%BEMT%DBEMT%element,2), size(x%BEMT%DBEMT%element,1), size(x%BEMT%DBEMT%element(1,1)%vind), Blade, BladeNode, StateIndex ) x%BEMT%DBEMT%element(BladeNode,Blade)%vind(StateIndex) = x%BEMT%DBEMT%element(BladeNode,Blade)%vind(StateIndex) + dx * perturb_sign else - call GetStateIndices( n - p%BEMT%DBEMT%lin_nx/2, size(x%BEMT%DBEMT%element,2), size(x%BEMT%DBEMT%element,1), size(x%BEMT%DBEMT%element(1,1)%vind_dot), Blade, BladeNode, StateIndex ) - x%BEMT%DBEMT%element(BladeNode,Blade)%vind_dot(StateIndex) = x%BEMT%DBEMT%element(BladeNode,Blade)%vind_dot(StateIndex) + dx * perturb_sign + call GetStateIndices( n - p%BEMT%DBEMT%lin_nx/2, size(x%BEMT%DBEMT%element,2), size(x%BEMT%DBEMT%element,1), size(x%BEMT%DBEMT%element(1,1)%vind_1), Blade, BladeNode, StateIndex ) + x%BEMT%DBEMT%element(BladeNode,Blade)%vind_1(StateIndex) = x%BEMT%DBEMT%element(BladeNode,Blade)%vind_1(StateIndex) + dx * perturb_sign 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 ) - call GetStateIndices( n - p%BEMT%DBEMT%lin_nx, size(x%BEMT%UA%element,2), size(x%BEMT%UA%element,1), 4, 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 + 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 end if @@ -5617,9 +5787,10 @@ 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, y_p, y_m, delta_p, delta_m, dY) +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) TYPE(RotOutputType) , INTENT(IN ) :: y_m !< AD outputs at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) REAL(R8Ki) , INTENT(IN ) :: delta_p !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ @@ -5679,8 +5850,8 @@ SUBROUTINE Compute_dX(p, x_p, x_m, delta_p, delta_m, dX) do j=1,size(x_p%BEMT%DBEMT%element,2) ! number of blades do i=1,size(x_p%BEMT%DBEMT%element,1) ! number of nodes per blade - dX(indx_first:indx_first+1) = x_p%BEMT%DBEMT%element(i,j)%vind_dot - x_m%BEMT%DBEMT%element(i,j)%vind_dot - indx_first = indx_first + size(x_p%BEMT%DBEMT%element(i,j)%vind_dot) !+=2 + dX(indx_first:indx_first+1) = x_p%BEMT%DBEMT%element(i,j)%vind_1 - x_m%BEMT%DBEMT%element(i,j)%vind_1 + indx_first = indx_first + size(x_p%BEMT%DBEMT%element(i,j)%vind_1) !+=2 end do end do @@ -5688,12 +5859,21 @@ SUBROUTINE Compute_dX(p, x_p, x_m, delta_p, delta_m, dX) if (p%BEMT%UA%lin_nx>0) 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: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 + 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 - 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 end if diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 index 7110eeb837..d6c91b8581 100644 --- a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -19,7 +19,7 @@ MODULE AeroDyn_AllBldNdOuts_IO ! Parameters related to output length (number of characters allowed in the output data headers): - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 6 ! The NREL allowed channel name length is usually 20. We are making these of the form B#N##namesuffix +! INTEGER(IntKi), PARAMETER :: OutStrLenM1_Msuffix = ChanLen - 6 ! The NREL allowed channel name length is usually 20. We are making these of the form B#N##namesuffix ! =================================================================================================== @@ -27,9 +27,9 @@ MODULE AeroDyn_AllBldNdOuts_IO ! 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 02-Mar-2022 11:12:19. - +! This code was generated by "Write_ChckOutLst.m" at 07-Sep-2022 16:16:13. + ! Indices for computing output channels: ! NOTES: ! (1) These parameters are in the order stored in "OutListParameters.xlsx" @@ -103,7 +103,7 @@ MODULE AeroDyn_AllBldNdOuts_IO ! The maximum number of output channels which can be output by the code. INTEGER(IntKi), PARAMETER, PUBLIC :: BldNd_MaxOutPts = 62 -!End of code generated by Matlab script +!End of code generated by Matlab script Write_ChckOutLst ! =================================================================================================== CONTAINS @@ -112,11 +112,10 @@ MODULE AeroDyn_AllBldNdOuts_IO !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated !! fastest). If this iteration order is changed, it should be changed in the Calc_WriteAllBldNdOutput routine as well. -SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, p_AD, InputFileData, ErrStat, ErrMsg ) +SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) TYPE(RotInitOutputType), INTENT(INOUT) :: InitOut ! output data TYPE(RotParameterType), INTENT(IN ) :: p ! The rotor parameters - TYPE(AD_ParameterType), INTENT(IN ) :: p_AD ! The module parameters TYPE(RotInputFile), INTENT(IN ) :: InputFileData ! All the data in the AeroDyn input file (want Blade Span for channel name) INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred @@ -1046,8 +1045,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx DO IdxBlade=1,p%BldNd_BladesOut iW = p_AD%FVW%Bld2Wings(iRot, IdxBlade) DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes -!NOT available in FVW yet - y%WriteOutput( OutIdx ) = 0.0_ReKi + y%WriteOutput( OutIdx ) = m_AD%FVW%W(iW)%BN_Cpmin(IdxNode) OutIdx = OutIdx + 1 ENDDO ENDDO @@ -1254,7 +1252,7 @@ SUBROUTINE AllBldNdOuts_SetParameters( InputFileData, p, p_AD, ErrStat, ErrMsg ) IF ( (InputFileData%BldNd_BladesOut < 0_IntKi) ) then p%BldNd_BladesOut = 0_IntKi ELSE IF ((InputFileData%BldNd_BladesOut > p%NumBlades) ) THEN - CALL SetErrStat( ErrID_Warn, " Number of blades to output data at all blade nodes (BldNd_BladesOut) must be less than "//TRIM(Num2LStr(p%NumBlades))//".", ErrStat, ErrMsg, RoutineName) + CALL SetErrStat( ErrID_Warn, " Number of blades to output data at all blade nodes (BldNd_BladesOut) must be no more than the total number of blades, "//TRIM(Num2LStr(p%NumBlades))//".", ErrStat, ErrMsg, RoutineName) p%BldNd_BladesOut = p%NumBlades ! NOTE: we are forgiving and plateau to numBlades ELSE p%BldNd_BladesOut = InputFileData%BldNd_BladesOut @@ -1321,7 +1319,7 @@ END SUBROUTINE AllBldNdOuts_SetParameters !! 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 02-Mar-2022 11:12:19. +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 07-Sep-2022 16:16:13. SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, p_AD, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -1343,7 +1341,6 @@ SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, p_AD, ErrStat, ErrMsg ) INTEGER :: INDX ! Index for valid arrays LOGICAL :: InvalidOutput(1:BldNd_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 = "BldNdOuts_SetOutParam" CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(62) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically @@ -1364,7 +1361,7 @@ SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, p_AD, ErrStat, ErrMsg ) BldNd_UA_x1 , BldNd_UA_x2 , BldNd_UA_x3 , BldNd_UA_x4 , BldNd_UA_x5 , BldNd_Uin , BldNd_Uir , BldNd_Uit , & BldNd_VDisx , BldNd_VDisy , BldNd_VDisz , BldNd_Vindx , BldNd_Vindy , BldNd_VRel , BldNd_VUndx , BldNd_Vundxi , & BldNd_VUndy , BldNd_Vundyi , BldNd_VUndz , BldNd_Vundzi , BldNd_Vx , BldNd_Vy /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(62) = (/ & ! This lists the units corresponding to the allowed parameters + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(62) = (/ character(ChanLen) :: & ! This lists the units corresponding to the allowed parameters "(deg) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(m) ","(-) ", & "(-) ","(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & "(-) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & @@ -1392,7 +1389,6 @@ SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, p_AD, ErrStat, ErrMsg ) ! The following are invalid for free vortex wake InvalidOutput( BldNd_Chi ) = .true. InvalidOutput( BldNd_Curve ) = .true. - InvalidOutput( BldNd_CpMin ) = .true. InvalidOutput( BldNd_GeomPhi ) = .true. ! applies only to BEM endif @@ -1427,13 +1423,14 @@ SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, p_AD, ErrStat, ErrMsg ) DO I = 1,p%BldNd_NumOuts p%BldNd_OutParam(I)%Name = BldNd_OutList(I) - OutListTmp = BldNd_OutList(I) - p%BldNd_OutParam(I)%SignM = 1 ! this won't be used - - CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case + Indx = FindValidChannelIndx(BldNd_OutList(I), ValidParamAry, p%BldNd_OutParam(I)%SignM) - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + if (p%BldNd_OutParam(I)%SignM /= 1) then ! this won't be used + CALL SetErrStat(ErrID_Severe, "Negative channels not allowed for nodal outputs. Resetting channel name.", ErrStat, ErrMsg, RoutineName) + p%BldNd_OutParam(I)%SignM = 1 + p%BldNd_OutParam(I)%Name = p%BldNd_OutParam(I)%Name(2:) ! remove the first character that makes this a negative value + end if IF ( Indx > 0 ) THEN ! we found the channel name IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings diff --git a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt index 5debd28f0f..ca84d6e9e8 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt @@ -45,7 +45,8 @@ 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=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(ChanLen) WriteOutputHdr {:} - - "Channel headers" "-" diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index 1993dbcd60..367a00f9a7 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -277,12 +277,17 @@ subroutine Dvr_TimeStep(nt, dvr, AD, IW, errStat, errMsg) ! VTK outputs - if (dvr%out%WrVTK==1 .and. nt==1) then + if ((dvr%out%WrVTK>=1 .and. nt==1) .or. (dvr%out%WrVTK==2)) then ! Init only - call WrVTK_Surfaces(time, dvr, dvr%out, nt-1, AD) - else if (dvr%out%WrVTK==2) then - ! Animation - call WrVTK_Surfaces(time, dvr, dvr%out, nt-1, AD) + select case (dvr%out%WrVTK_Type) + case (1) ! surfaces + call WrVTK_Surfaces(time, dvr, dvr%out, nt-1, AD) + case (2) ! lines + call WrVTK_Lines( time, dvr, dvr%out, nt-1, AD) + case (3) ! both + call WrVTK_Surfaces(time, dvr, dvr%out, nt-1, AD) + call WrVTK_Lines( time, dvr, dvr%out, nt-1, AD) + end select endif ! Get state variables at next step: INPUT at step nt - 1, OUTPUT at step nt @@ -1391,8 +1396,8 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) call ParseAry(FileInfo_In, CurLine, 'nacOrigin_t'//sWT , wt%nac%origin_t, 3 , errStat2, errMsg2, unEc); if(Failed()) return call ParseAry(FileInfo_In, CurLine, 'hubOrigin_n'//sWT , wt%hub%origin_n, 3 , errStat2, errMsg2, unEc); if(Failed()) return call ParseAry(FileInfo_In, CurLine, 'hubOrientation_n'//sWT , wt%hub%orientation_n, 3 , errStat2, errMsg2, unEc); if(Failed()) return - wt%hub%orientation_n = wt%hub%orientation_n*Pi/180_ReKi - wt%orientationInit = wt%orientationInit*Pi/180_ReKi + wt%hub%orientation_n = wt%hub%orientation_n*D2R + wt%orientationInit = wt%orientationInit*D2R ! Blades call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if(Failed()) return call ParseVar(FileInfo_In, CurLine, 'numBlades'//sWT , wt%numBlades, errStat2, errMsg2, unEc); if(Failed()) return @@ -1587,6 +1592,7 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) call ParseVar(FileInfo_In, CurLine, 'outFmt' , dvr%out%outFmt , errStat2, errMsg2, unEc); if(Failed()) return call ParseVar(FileInfo_In, CurLine, 'outFileFmt' , dvr%out%fileFmt , errStat2, errMsg2, unEc); if(Failed()) return call ParseVar(FileInfo_In, CurLine, 'WrVTK' , dvr%out%WrVTK , errStat2, errMsg2, unEc); if(Failed()) return + call ParseVar(FileInfo_In, CurLine, 'WrVTK_Type' , dvr%out%WrVTK_Type , errStat2, errMsg2, unEc); if(Failed()) return call ParseVar(FileInfo_In, CurLine, 'VTKHubRad' , hubRad_ReKi , errStat2, errMsg2, unEc); if(Failed()) return call ParseAry(FileInfo_In, CurLine, 'VTKNacDim' , dvr%out%VTKNacDim, 6, errStat2, errMsg2, unEc); if(Failed()) return dvr%out%VTKHubRad = real(hubRad_ReKi,SiKi) @@ -1703,6 +1709,12 @@ subroutine ValidateInputs(dvr, errStat, errMsg) !if ( FmtWidth < MinChanLen ) call SetErrStat( ErrID_Warn, 'OutFmt produces a column less than '//trim(num2lstr(MinChanLen))//' characters wide ('// & ! TRIM(Num2LStr(FmtWidth))//'), which may be too small.', ErrStat, ErrMsg, RoutineName ) + if (Check((dvr%out%WrVTK<0 .or. dvr%out%WrVTK>2 ), 'WrVTK must be 0 (none), 1 (initialization only), 2 (animation), or 3 (mode shapes).')) then + return + else + if (Check((dvr%out%WrVTK_Type<1 .or. dvr%out%WrVTK_Type>3), 'VTK_type must be 1 (surfaces), 2 (lines/points), or 3 (both).')) return + endif + contains logical function Check(Condition, ErrMsg_in) @@ -1836,7 +1848,7 @@ subroutine Dvr_InitializeDriverOutputs(dvr, errStat, errMsg) dvr%out%WriteOutputHdr(j) = 'ShearExp' if (dvr%CompInflow==1) then - dvr%out%WriteOutputUnt(j) = '(NVALID)'; j=j+1 + dvr%out%WriteOutputUnt(j) = '(INVALID)'; j=j+1 else dvr%out%WriteOutputUnt(j) = '(-)'; j=j+1 endif @@ -2124,8 +2136,8 @@ SUBROUTINE SetVTKParameters(p_FAST, dvr, InitOutData_AD, AD, ErrStat, ErrMsg) allocate(p_FAST%VTK_Surface(dvr%numTurbines)) ! --- Find dimensions for all objects to determine "Ground" and typical dimensions - WorldBoxMax(2) =-HUGE(1.0_SiKi) - WorldBoxMin(2) = HUGE(1.0_SiKi) + WorldBoxMax =-HUGE(1.0_SiKi) + WorldBoxMin = HUGE(1.0_SiKi) MaxBladeLength=0 MaxTwrLength=0 do iWT=1,dvr%numTurbines @@ -2300,7 +2312,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, dvr, p_FAST, VTK_count, AD) end do if (p_FAST%WrVTK>1) then - ! --- Debug outputs + ! --- animations ! Tower base call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, wt%twr%ptMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseSurface', & VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , & @@ -2324,6 +2336,59 @@ SUBROUTINE WrVTK_Surfaces(t_global, dvr, p_FAST, VTK_count, AD) 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, dvr, p_FAST, VTK_count, AD) + use FVW_IO, only: WrVTK_FVW + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + type(Dvr_SimData), target, intent(inout) :: dvr ! intent(out) only so that we can save FmtWidth in dvr%out%ActualChanLen + TYPE(Dvr_Outputs), INTENT(IN ) :: p_FAST !< Parameters for the glue code + INTEGER(IntKi) , INTENT(IN ) :: VTK_count + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + 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) :: k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Lines' + integer(IntKi) :: iWT + type(WTData), pointer :: wt ! Alias to shorten notation + character(10) :: sWT + + do iWT = 1, size(dvr%WT) + sWT = '.T'//trim(num2lstr(iWT)) + wt=>dvr%WT(iWT) + + ! Tower motions + if (AD%u(2)%rotors(iWT)%TowerMotion%nNodes>0) then + call MeshWrVTK(p_FAST%VTKRefPoint, AD%u(2)%rotors(iWT)%TowerMotion, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.Tower', & + VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + endif + + if (wt%numBlades>0) then + ! Nacelle + call MeshWrVTK(p_FAST%VTKRefPoint, wt%nac%ptMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.Nacelle', & + VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + + ! Hub + call MeshWrVTK(p_FAST%VTKRefPoint, AD%u(2)%rotors(iWT)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.Hub', & + VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + endif + + ! Blades + do K=1,wt%numBlades + call MeshWrVTK(p_FAST%VTKRefPoint, AD%u(2)%rotors(iWT)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(k)), & + VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=AD%y%rotors(iWT)%BladeLoad(k) ) + end do + enddo + + ! Free wake (only write this here if doing line meshes only -- FVW is written with surface outputs) + if (allocated(AD%m%FVW_u) .and. dvr%out%WrVTK_Type==2) then + if (allocated(AD%m%FVW_u(1)%WingsMesh)) then + call WrVTK_FVW(AD%p%FVW, AD%x%FVW, AD%z%FVW, AD%m%FVW, trim(p_FAST%VTK_OutFileRoot)//'.FVW', VTK_count, p_FAST%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + end if + end if +END SUBROUTINE WrVTK_Lines +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the ground or seabed reference surface information in VTK format. !! see VTK file information format for XML, here: http://www.vtk.org/wp-content/uploads/2015/04/file-formats.pdf SUBROUTINE WrVTK_Ground ( RefPoint, HalfLengths, FileRootName, ErrStat, ErrMsg ) diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 61f020d76d..6169d5dde3 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -76,7 +76,8 @@ MODULE AeroDyn_Driver_Types 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=animation [-] + 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) [-] character(1024) :: Root !< Output file rootname [-] character(1024) :: VTK_OutFileRoot !< Output file rootname for vtk [-] character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Channel headers [-] @@ -272,15 +273,27 @@ SUBROUTINE AD_Dvr_CopyDvr_Case( SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrS DstDvr_CaseData%frequency = SrcDvr_CaseData%frequency END SUBROUTINE AD_Dvr_CopyDvr_Case - SUBROUTINE AD_Dvr_DestroyDvr_Case( Dvr_CaseData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Case' + LOGICAL,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 ) @@ -468,15 +481,27 @@ SUBROUTINE AD_Dvr_CopyDvrVTK_BLSurfaceType( SrcDvrVTK_BLSurfaceTypeData, DstDvrV ENDIF END SUBROUTINE AD_Dvr_CopyDvrVTK_BLSurfaceType - SUBROUTINE AD_Dvr_DestroyDvrVTK_BLSurfaceType( DvrVTK_BLSurfaceTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_Dvr_DestroyDvrVTK_BLSurfaceType( DvrVTK_BLSurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DvrVTK_BLSurfaceType), INTENT(INOUT) :: DvrVTK_BLSurfaceTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvrVTK_BLSurfaceType' + LOGICAL,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_BLSurfaceType' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + IF (ALLOCATED(DvrVTK_BLSurfaceTypeData%AirfoilCoords)) THEN DEALLOCATE(DvrVTK_BLSurfaceTypeData%AirfoilCoords) ENDIF @@ -684,21 +709,34 @@ SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType( SrcDvrVTK_SurfaceTypeData, DstDvrVTK_S ENDIF END SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType - SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType( DvrVTK_SurfaceTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvrVTK_SurfaceType' + LOGICAL,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 + IF (ALLOCATED(DvrVTK_SurfaceTypeData%TowerRad)) THEN DEALLOCATE(DvrVTK_SurfaceTypeData%TowerRad) ENDIF IF (ALLOCATED(DvrVTK_SurfaceTypeData%BladeShape)) THEN DO i1 = LBOUND(DvrVTK_SurfaceTypeData%BladeShape,1), UBOUND(DvrVTK_SurfaceTypeData%BladeShape,1) - CALL AD_Dvr_Destroydvrvtk_blsurfacetype( DvrVTK_SurfaceTypeData%BladeShape(i1), ErrStat, ErrMsg ) + CALL AD_Dvr_Destroydvrvtk_blsurfacetype( DvrVTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DvrVTK_SurfaceTypeData%BladeShape) ENDIF @@ -1036,6 +1074,7 @@ SUBROUTINE AD_Dvr_CopyDvr_Outputs( SrcDvr_OutputsData, DstDvr_OutputsData, CtrlC 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 @@ -1113,16 +1152,29 @@ SUBROUTINE AD_Dvr_CopyDvr_Outputs( SrcDvr_OutputsData, DstDvr_OutputsData, CtrlC DstDvr_OutputsData%VTKRefPoint = SrcDvr_OutputsData%VTKRefPoint END SUBROUTINE AD_Dvr_CopyDvr_Outputs - SUBROUTINE AD_Dvr_DestroyDvr_Outputs( Dvr_OutputsData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyprogdesc( Dvr_OutputsData%AD_ver, ErrStat, 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 @@ -1140,7 +1192,8 @@ SUBROUTINE AD_Dvr_DestroyDvr_Outputs( Dvr_OutputsData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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 @@ -1212,6 +1265,7 @@ SUBROUTINE AD_Dvr_PackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 @@ -1356,6 +1410,8 @@ SUBROUTINE AD_Dvr_PackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 @@ -1606,6 +1662,8 @@ SUBROUTINE AD_Dvr_UnPackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta 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 @@ -1820,25 +1878,45 @@ SUBROUTINE AD_Dvr_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, Ct DstAeroDyn_DataData%InputTime = SrcAeroDyn_DataData%InputTime END SUBROUTINE AD_Dvr_CopyAeroDyn_Data - SUBROUTINE AD_Dvr_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) + SUBROUTINE AD_Dvr_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyAeroDyn_Data' + LOGICAL,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_DestroyAeroDyn_Data' + ErrStat = ErrID_None ErrMsg = "" - CALL AD_DestroyContState( AeroDyn_DataData%x, ErrStat, ErrMsg ) - CALL AD_DestroyDiscState( AeroDyn_DataData%xd, ErrStat, ErrMsg ) - CALL AD_DestroyConstrState( AeroDyn_DataData%z, ErrStat, ErrMsg ) - CALL AD_DestroyOtherState( AeroDyn_DataData%OtherState, ErrStat, ErrMsg ) - CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat, ErrMsg ) - CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat, ErrMsg ) + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL AD_DestroyContState( AeroDyn_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD_DestroyDiscState( AeroDyn_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD_DestroyConstrState( AeroDyn_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD_DestroyOtherState( AeroDyn_DataData%OtherState, 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) + CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) DO i1 = LBOUND(AeroDyn_DataData%u,1), UBOUND(AeroDyn_DataData%u,1) - CALL AD_DestroyInput( AeroDyn_DataData%u(i1), ErrStat, ErrMsg ) + CALL AD_DestroyInput( AeroDyn_DataData%u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat, ErrMsg ) + CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_Dvr_DestroyAeroDyn_Data SUBROUTINE AD_Dvr_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2678,25 +2756,45 @@ SUBROUTINE AD_Dvr_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_Dat DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes END SUBROUTINE AD_Dvr_CopyInflowWind_Data - SUBROUTINE AD_Dvr_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) + SUBROUTINE AD_Dvr_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyInflowWind_Data' + LOGICAL,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_DestroyInflowWind_Data' + ErrStat = ErrID_None ErrMsg = "" - CALL InflowWind_DestroyContState( InflowWind_DataData%x, ErrStat, ErrMsg ) - CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd, ErrStat, ErrMsg ) - CALL InflowWind_DestroyConstrState( InflowWind_DataData%z, ErrStat, ErrMsg ) - CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt, ErrStat, ErrMsg ) - CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat, ErrMsg ) - CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat, ErrMsg ) + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL InflowWind_DestroyContState( InflowWind_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyConstrState( InflowWind_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyParam( InflowWind_DataData%p, 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) DO i1 = LBOUND(InflowWind_DataData%u,1), UBOUND(InflowWind_DataData%u,1) - CALL InflowWind_DestroyInput( InflowWind_DataData%u(i1), ErrStat, ErrMsg ) + CALL InflowWind_DestroyInput( InflowWind_DataData%u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat, ErrMsg ) + CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_Dvr_DestroyInflowWind_Data SUBROUTINE AD_Dvr_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3543,21 +3641,36 @@ SUBROUTINE AD_Dvr_CopyBladeData( SrcBladeDataData, DstBladeDataData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_Dvr_CopyBladeData - SUBROUTINE AD_Dvr_DestroyBladeData( BladeDataData, ErrStat, ErrMsg ) + SUBROUTINE AD_Dvr_DestroyBladeData( BladeDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BladeData), INTENT(INOUT) :: BladeDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyBladeData' + LOGICAL,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 - CALL MeshDestroy( BladeDataData%ptMesh, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( BladeDataData%ED_P_2_AD_P_R, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( BladeDataData%AD_P_2_AD_L_B, ErrStat, ErrMsg ) + CALL MeshDestroy( BladeDataData%ptMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( BladeDataData%ED_P_2_AD_P_R, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( BladeDataData%AD_P_2_AD_L_B, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_Dvr_DestroyBladeData SUBROUTINE AD_Dvr_PackBladeData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -4098,23 +4211,38 @@ SUBROUTINE AD_Dvr_CopyHubData( SrcHubDataData, DstHubDataData, CtrlCode, ErrStat ENDIF END SUBROUTINE AD_Dvr_CopyHubData - SUBROUTINE AD_Dvr_DestroyHubData( HubDataData, ErrStat, ErrMsg ) + SUBROUTINE AD_Dvr_DestroyHubData( HubDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HubData), INTENT(INOUT) :: HubDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyHubData' + LOGICAL,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 - CALL MeshDestroy( HubDataData%ptMesh, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( HubDataData%ED_P_2_AD_P_H, ErrStat, ErrMsg ) + CALL MeshDestroy( HubDataData%ptMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( HubDataData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(HubDataData%map2BldPt)) THEN DO i1 = LBOUND(HubDataData%map2BldPt,1), UBOUND(HubDataData%map2BldPt,1) - CALL NWTC_Library_Destroymeshmaptype( HubDataData%map2BldPt(i1), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( HubDataData%map2BldPt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(HubDataData%map2BldPt) ENDIF @@ -4657,21 +4785,36 @@ SUBROUTINE AD_Dvr_CopyNacData( SrcNacDataData, DstNacDataData, CtrlCode, ErrStat IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_Dvr_CopyNacData - SUBROUTINE AD_Dvr_DestroyNacData( NacDataData, ErrStat, ErrMsg ) + SUBROUTINE AD_Dvr_DestroyNacData( NacDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(NacData), INTENT(INOUT) :: NacDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyNacData' + LOGICAL,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 - CALL MeshDestroy( NacDataData%ptMesh, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( NacDataData%ED_P_2_AD_P_N, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( NacDataData%map2hubPt, ErrStat, ErrMsg ) + CALL MeshDestroy( NacDataData%ptMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( NacDataData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( NacDataData%map2hubPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_Dvr_DestroyNacData SUBROUTINE AD_Dvr_PackNacData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -5147,19 +5290,35 @@ SUBROUTINE AD_Dvr_CopyTwrData( SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_Dvr_CopyTwrData - SUBROUTINE AD_Dvr_DestroyTwrData( TwrDataData, ErrStat, ErrMsg ) + SUBROUTINE AD_Dvr_DestroyTwrData( TwrDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(TwrData), INTENT(INOUT) :: TwrDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyTwrData' + LOGICAL,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 = "" - CALL MeshDestroy( TwrDataData%ptMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( TwrDataData%ptMeshAD, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( TwrDataData%ED_P_2_AD_P_T, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( TwrDataData%AD_P_2_AD_L_T, ErrStat, ErrMsg ) + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL MeshDestroy( TwrDataData%ptMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( TwrDataData%ptMeshAD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( TwrDataData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( TwrDataData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_Dvr_DestroyTwrData SUBROUTINE AD_Dvr_PackTwrData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -5697,27 +5856,46 @@ SUBROUTINE AD_Dvr_CopyWTData( SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, E ENDIF END SUBROUTINE AD_Dvr_CopyWTData - SUBROUTINE AD_Dvr_DestroyWTData( WTDataData, ErrStat, ErrMsg ) + SUBROUTINE AD_Dvr_DestroyWTData( WTDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WTData), INTENT(INOUT) :: WTDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyWTData' + LOGICAL,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 = "" - CALL MeshDestroy( WTDataData%ptMesh, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2twrPt, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2nacPt, ErrStat, ErrMsg ) + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL MeshDestroy( WTDataData%ptMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) IF (ALLOCATED(WTDataData%bld)) THEN DO i1 = LBOUND(WTDataData%bld,1), UBOUND(WTDataData%bld,1) - CALL AD_Dvr_Destroybladedata( WTDataData%bld(i1), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL AD_Dvr_Destroynacdata( WTDataData%nac, ErrStat, ErrMsg ) - CALL AD_Dvr_Destroytwrdata( WTDataData%twr, ErrStat, ErrMsg ) + 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 @@ -6703,31 +6881,46 @@ SUBROUTINE AD_Dvr_CopyDvr_SimData( SrcDvr_SimDataData, DstDvr_SimDataData, CtrlC IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_Dvr_CopyDvr_SimData - SUBROUTINE AD_Dvr_DestroyDvr_SimData( Dvr_SimDataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + CALL AD_Dvr_Destroydvr_outputs( Dvr_SimDataData%out, 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 ) @@ -7353,18 +7546,33 @@ SUBROUTINE AD_Dvr_CopyAllData( SrcAllDataData, DstAllDataData, CtrlCode, ErrStat DstAllDataData%initialized = SrcAllDataData%initialized END SUBROUTINE AD_Dvr_CopyAllData - SUBROUTINE AD_Dvr_DestroyAllData( AllDataData, ErrStat, ErrMsg ) + SUBROUTINE AD_Dvr_DestroyAllData( AllDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AllData), INTENT(INOUT) :: AllDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyAllData' + LOGICAL,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 = "" - CALL AD_Dvr_Destroydvr_simdata( AllDataData%dvr, ErrStat, ErrMsg ) - CALL AD_Dvr_Destroyaerodyn_data( AllDataData%AD, ErrStat, ErrMsg ) - CALL AD_Dvr_Destroyinflowwind_data( AllDataData%IW, ErrStat, 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 AD_Dvr_Destroyaerodyn_data( AllDataData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD_Dvr_Destroyinflowwind_data( AllDataData%IW, 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 ) diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index e32881ef72..4a4860e692 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -38,13 +38,7 @@ MODULE AeroDyn_IO ! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these ! lines should be modified in the Matlab script and/or Excel worksheet as necessary. ! =================================================================================================== -! This code was generated by Write_ChckOutLst.m at 01-Mar-2022 11:16:33. - - - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - +! This code was generated by "Write_ChckOutLst.m" at 07-Sep-2022 16:15:54. ! Indices for computing output channels: ! NOTES: @@ -1345,7 +1339,7 @@ MODULE AeroDyn_IO ! The maximum number of output channels which can be output by the code. INTEGER(IntKi), PARAMETER :: MaxOutPts = 1270 -!End of code generated by Matlab script +!End of code generated by Matlab script Write_ChckOutLst ! =================================================================================================== INTEGER, PARAMETER :: TwNVUnd(3, 9) = RESHAPE( (/ & ! Undisturbed wind velocity @@ -1654,11 +1648,12 @@ END FUNCTION Calc_Chi0 !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteOutput( p, p_AD, u, m, m_AD, y, OtherState, xd, indx, iRot, ErrStat, ErrMsg ) +SUBROUTINE Calc_WriteOutput( p, p_AD, u, 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(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(RotMiscVarType), INTENT(INOUT) :: m ! misc variables TYPE(AD_MiscVarType), INTENT(INOUT) :: m_AD ! misc variables TYPE(RotOutputType), INTENT(IN ) :: y ! outputs @@ -1985,7 +1980,7 @@ subroutine Calc_WriteOutput_FVW 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%BEMT_y%Cpmin(jk) ! 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) m%AllOuts( BNCd( beta,k) ) = m_AD%FVW%W(iW)%BN_Cd(j) m%AllOuts( BNCm( beta,k) ) = m_AD%FVW%W(iW)%BN_Cm(j) @@ -2079,7 +2074,7 @@ SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot iBld = iBld+1 ! Increment blade counter END DO - ENDDO ! Loop on rotors + end do ! loop on rotors CALL Cleanup ( ) @@ -2408,8 +2403,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade 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, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) + call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%OutList, InputFileData%NumOuts, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; !====== Nodal Outputs ============================================================================== @@ -2437,8 +2431,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 - call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%BldNd_OutList, & - InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output nodal channel groups", ErrStat2, ErrMsg2, UnEc ) + call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, ErrStat2, ErrMsg2, UnEc ) if (FailedNodal()) return; RETURN @@ -2617,8 +2610,12 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) CHARACTER(*), PARAMETER :: FmtDatT = '(A,T35,1(:,F13.8))' ! Format for outputting time steps. CHARACTER(30) :: OutPFmt ! Format to print list of selected output channels to summary file + CHARACTER(30) :: OutPFmtS ! Format to print list of selected output channels to summary file CHARACTER(100) :: Msg ! temporary string for writing appropriate text to summary file + CHARACTER(ChanLen),PARAMETER :: TitleStr(2) = (/ 'Parameter', 'Units ' /) + CHARACTER(ChanLen),PARAMETER :: TitleStrLines(2) = (/ '---------------', '---------------' /) + ! Open the summary file and give it a heading. CALL GetNewUnit( UnSu, ErrStat, ErrMsg ) @@ -2803,7 +2800,7 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) Msg = 'Stieg Oye dynamic stall model' case (UA_BV) Msg = 'Boeing-Vertol dynamic stall model (e.g. used in CACTUS)' - case default + case default Msg = 'unknown' end select WRITE (UnSu,Ec_IntFrmt) InputFileData%UAMod, 'UAMod', 'Unsteady Aero Model: '//TRIM(Msg) @@ -2845,11 +2842,12 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) end if - OutPFmt = '( 15x, I4, 2X, A '//TRIM(Num2LStr(ChanLen))//',1 X, A'//TRIM(Num2LStr(ChanLen))//' )' + OutPFmt = '( 15x, I4, 3X,A '//TRIM(Num2LStr(ChanLen))//',1 X, A'//TRIM(Num2LStr(ChanLen))//' )' + OutPFmtS = '( 15x, A4, 3X,A '//TRIM(Num2LStr(ChanLen))//',1 X, A'//TRIM(Num2LStr(ChanLen))//' )' + WRITE (UnSu,'(15x,A)') WRITE (UnSu,'(15x,A)') 'Requested Output Channels:' - WRITE (UnSu,'(15x,A)') 'Col Parameter Units' - WRITE (UnSu,'(15x,A)') '---- -------------- -----' - + WRITE (UnSu,OutPFmtS ) "Col", TitleStr + WRITE (UnSu,OutPFmtS ) "---", TitleStrLines DO I = 0,p%NumOuts WRITE (UnSu,OutPFmt) I, p%OutParam(I)%Name, p%OutParam(I)%Units END DO @@ -2857,11 +2855,12 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) WRITE (UnSu,'(15x,A)') WRITE (UnSu,'(15x,A)') WRITE (UnSu,'(15x,A)') 'Requested Output Channels at each blade station:' - WRITE (UnSu,'(15x,A)') 'Col Parameter Units' - WRITE (UnSu,'(15x,A)') '---- -------------- -----' + WRITE (UnSu,OutPFmtS ) "Col", TitleStr + WRITE (UnSu,OutPFmtS ) "---", TitleStrLines DO I = 1,p%BldNd_NumOuts WRITE (UnSu,OutPFmt) I, p%BldNd_OutParam(I)%Name, p%BldNd_OutParam(I)%Units - END DO + END DO + CLOSE(UnSu) @@ -2881,7 +2880,7 @@ 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 01-Mar-2022 11:16:33. +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 07-Sep-2022 16:15:55. SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -2902,9 +2901,7 @@ SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) 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(1270) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically @@ -3227,7 +3224,7 @@ SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) TwN8Fdy , TwN8M , TwN8Re , TwN8STVx , TwN8STVy , TwN8STVz , TwN8Vrel , TwN8VUndx , & TwN8VUndy , TwN8VUndz , TwN9DynP , TwN9Fdx , TwN9Fdy , TwN9M , TwN9Re , TwN9STVx , & TwN9STVy , TwN9STVz , TwN9Vrel , TwN9VUndx , TwN9VUndy , TwN9VUndz /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(1270) = (/ & ! This lists the units corresponding to the allowed parameters + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(1270) = (/ 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) ","(deg) ","(-) ", & "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ", & @@ -3403,7 +3400,7 @@ SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) ! BNClrnc is set only when we're computing the tower influence do i = 1,size(BNClrnc,2) ! all blades (need to do this in a loop because we need the index of InvalidOutput to be an array of rank one) - InvalidOutput( BNClrnc(:,i) ) = .true. + InvalidOutput( BNClrnc(:,i) ) = .true. end do end if @@ -3551,39 +3548,8 @@ SUBROUTINE SetOutParam(OutList, p, p_AD, 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 IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 677430d4ca..ae2fc67c5c 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -423,15 +423,27 @@ SUBROUTINE AD_CopyRotInitInputType( SrcRotInitInputTypeData, DstRotInitInputType DstRotInitInputTypeData%AeroProjMod = SrcRotInitInputTypeData%AeroProjMod END SUBROUTINE AD_CopyRotInitInputType - SUBROUTINE AD_DestroyRotInitInputType( RotInitInputTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyRotInitInputType( RotInitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotInitInputType), INTENT(INOUT) :: RotInitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInitInputType' + LOGICAL,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 @@ -757,22 +769,36 @@ SUBROUTINE AD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL END SUBROUTINE AD_CopyInitInput - SUBROUTINE AD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInitInput' + LOGICAL,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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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 ) @@ -1249,15 +1275,27 @@ SUBROUTINE AD_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, ENDIF END SUBROUTINE AD_CopyBladePropsType - SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_BladePropsType), INTENT(INOUT) :: BladePropsTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyBladePropsType' + LOGICAL,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 @@ -1680,15 +1718,27 @@ SUBROUTINE AD_CopyBladeShape( SrcBladeShapeData, DstBladeShapeData, CtrlCode, Er ENDIF END SUBROUTINE AD_CopyBladeShape - SUBROUTINE AD_DestroyBladeShape( BladeShapeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyBladeShape( BladeShapeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_BladeShape), INTENT(INOUT) :: BladeShapeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyBladeShape' + LOGICAL,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 @@ -2041,15 +2091,27 @@ SUBROUTINE AD_CopyRotInitOutputType( SrcRotInitOutputTypeData, DstRotInitOutputT ENDIF END SUBROUTINE AD_CopyRotInitOutputType - SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotInitOutputType), INTENT(INOUT) :: RotInitOutputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInitOutputType' + LOGICAL,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 @@ -2058,7 +2120,8 @@ SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(RotInitOutputTypeData%BladeShape)) THEN DO i1 = LBOUND(RotInitOutputTypeData%BladeShape,1), UBOUND(RotInitOutputTypeData%BladeShape,1) - CALL AD_Destroybladeshape( RotInitOutputTypeData%BladeShape(i1), ErrStat, ErrMsg ) + CALL AD_Destroybladeshape( RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotInitOutputTypeData%BladeShape) ENDIF @@ -2085,7 +2148,8 @@ SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(RotInitOutputTypeData%BladeProps)) THEN DO i1 = LBOUND(RotInitOutputTypeData%BladeProps,1), UBOUND(RotInitOutputTypeData%BladeProps,1) - CALL AD_Destroybladepropstype( RotInitOutputTypeData%BladeProps(i1), ErrStat, ErrMsg ) + CALL AD_Destroybladepropstype( RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotInitOutputTypeData%BladeProps) ENDIF @@ -2951,22 +3015,36 @@ SUBROUTINE AD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyInitOutput - SUBROUTINE AD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInitOutput' + LOGICAL,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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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 ) @@ -3350,18 +3428,31 @@ SUBROUTINE AD_CopyRotInputFile( SrcRotInputFileData, DstRotInputFileData, CtrlCo ENDIF END SUBROUTINE AD_CopyRotInputFile - SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotInputFile), INTENT(INOUT) :: RotInputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInputFile' + LOGICAL,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), ErrStat, ErrMsg ) + CALL AD_Destroybladepropstype( RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotInputFileData%BladeProps) ENDIF @@ -3880,15 +3971,27 @@ SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt ENDIF END SUBROUTINE AD_CopyInputFile - SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInputFile' + LOGICAL,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 @@ -3903,7 +4006,8 @@ SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%rotors)) THEN DO i1 = LBOUND(InputFileData%rotors,1), UBOUND(InputFileData%rotors,1) - CALL AD_Destroyrotinputfile( InputFileData%rotors(i1), ErrStat, ErrMsg ) + CALL AD_Destroyrotinputfile( InputFileData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputFileData%rotors) ENDIF @@ -4582,17 +4686,31 @@ SUBROUTINE AD_CopyRotContinuousStateType( SrcRotContinuousStateTypeData, DstRotC IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyRotContinuousStateType - SUBROUTINE AD_DestroyRotContinuousStateType( RotContinuousStateTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyRotContinuousStateType( RotContinuousStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotContinuousStateType), INTENT(INOUT) :: RotContinuousStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotContinuousStateType' + LOGICAL,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 = "" - CALL BEMT_DestroyContState( RotContinuousStateTypeData%BEMT, ErrStat, ErrMsg ) - CALL AA_DestroyContState( RotContinuousStateTypeData%AA, ErrStat, 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 ) @@ -4894,22 +5012,36 @@ SUBROUTINE AD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyContState - SUBROUTINE AD_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyContState' + LOGICAL,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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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 ) @@ -5233,17 +5365,31 @@ SUBROUTINE AD_CopyRotDiscreteStateType( SrcRotDiscreteStateTypeData, DstRotDiscr IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyRotDiscreteStateType - SUBROUTINE AD_DestroyRotDiscreteStateType( RotDiscreteStateTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyRotDiscreteStateType( RotDiscreteStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotDiscreteStateType), INTENT(INOUT) :: RotDiscreteStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotDiscreteStateType' + LOGICAL,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 = "" - CALL BEMT_DestroyDiscState( RotDiscreteStateTypeData%BEMT, ErrStat, ErrMsg ) - CALL AA_DestroyDiscState( RotDiscreteStateTypeData%AA, ErrStat, 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 ) @@ -5545,22 +5691,36 @@ SUBROUTINE AD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyDiscState - SUBROUTINE AD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyDiscState' + LOGICAL,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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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 ) @@ -5884,17 +6044,31 @@ SUBROUTINE AD_CopyRotConstraintStateType( SrcRotConstraintStateTypeData, DstRotC IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyRotConstraintStateType - SUBROUTINE AD_DestroyRotConstraintStateType( RotConstraintStateTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyRotConstraintStateType( RotConstraintStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotConstraintStateType), INTENT(INOUT) :: RotConstraintStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotConstraintStateType' + LOGICAL,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 = "" - CALL BEMT_DestroyConstrState( RotConstraintStateTypeData%BEMT, ErrStat, ErrMsg ) - CALL AA_DestroyConstrState( RotConstraintStateTypeData%AA, ErrStat, 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 ) @@ -6196,22 +6370,36 @@ SUBROUTINE AD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyConstrState - SUBROUTINE AD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyConstrState' + LOGICAL,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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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 ) @@ -6535,17 +6723,31 @@ SUBROUTINE AD_CopyRotOtherStateType( SrcRotOtherStateTypeData, DstRotOtherStateT IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyRotOtherStateType - SUBROUTINE AD_DestroyRotOtherStateType( RotOtherStateTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyRotOtherStateType( RotOtherStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotOtherStateType), INTENT(INOUT) :: RotOtherStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotOtherStateType' + LOGICAL,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 = "" - CALL BEMT_DestroyOtherState( RotOtherStateTypeData%BEMT, ErrStat, ErrMsg ) - CALL AA_DestroyOtherState( RotOtherStateTypeData%AA, ErrStat, 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 ) @@ -6862,22 +7064,36 @@ SUBROUTINE AD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er ENDIF END SUBROUTINE AD_CopyOtherState - SUBROUTINE AD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyOtherState' + LOGICAL,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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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 @@ -7530,23 +7746,41 @@ SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, ENDIF END SUBROUTINE AD_CopyRotMiscVarType - SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotMiscVarType), INTENT(INOUT) :: RotMiscVarTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotMiscVarType' + LOGICAL,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 = "" - CALL BEMT_DestroyMisc( RotMiscVarTypeData%BEMT, ErrStat, ErrMsg ) - CALL BEMT_DestroyOutput( RotMiscVarTypeData%BEMT_y, ErrStat, 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), ErrStat, ErrMsg ) + CALL BEMT_DestroyInput( RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL AA_DestroyMisc( RotMiscVarTypeData%AA, ErrStat, ErrMsg ) - CALL AA_DestroyOutput( RotMiscVarTypeData%AA_y, ErrStat, ErrMsg ) - CALL AA_DestroyInput( RotMiscVarTypeData%AA_u, ErrStat, ErrMsg ) + 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 @@ -7583,10 +7817,12 @@ SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg ) IF (ALLOCATED(RotMiscVarTypeData%hub_theta_x_root)) THEN DEALLOCATE(RotMiscVarTypeData%hub_theta_x_root) ENDIF - CALL MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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 @@ -7601,13 +7837,15 @@ SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(RotMiscVarTypeData%BladeRootLoad)) THEN DO i1 = LBOUND(RotMiscVarTypeData%BladeRootLoad,1), UBOUND(RotMiscVarTypeData%BladeRootLoad,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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 @@ -9444,29 +9682,45 @@ SUBROUTINE AD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyMisc - SUBROUTINE AD_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyMisc' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL FVW_DestroyMisc( MiscData%FVW, ErrStat, ErrMsg ) + 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 ) @@ -10143,15 +10397,27 @@ SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterType DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut END SUBROUTINE AD_CopyRotParameterType - SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotParameterType), INTENT(INOUT) :: RotParameterTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotParameterType' + LOGICAL,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 @@ -10161,8 +10427,10 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg ) IF (ALLOCATED(RotParameterTypeData%TwrTI)) THEN DEALLOCATE(RotParameterTypeData%TwrTI) ENDIF - CALL BEMT_DestroyParam( RotParameterTypeData%BEMT, ErrStat, ErrMsg ) - CALL AA_DestroyParam( RotParameterTypeData%AA, ErrStat, ErrMsg ) + 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 @@ -10174,13 +10442,15 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(RotParameterTypeData%OutParam)) THEN DO i1 = LBOUND(RotParameterTypeData%OutParam,1), UBOUND(RotParameterTypeData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( RotParameterTypeData%OutParam(i1), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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 @@ -11183,28 +11453,43 @@ SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%UA_Flag = SrcParamData%UA_Flag END SUBROUTINE AD_CopyParam - SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyParam' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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 ) @@ -11760,27 +12045,44 @@ SUBROUTINE AD_CopyRotInputType( SrcRotInputTypeData, DstRotInputTypeData, CtrlCo ENDIF END SUBROUTINE AD_CopyRotInputType - SUBROUTINE AD_DestroyRotInputType( RotInputTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyRotInputType( RotInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotInputType), INTENT(INOUT) :: RotInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInputType' + LOGICAL,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 = "" - CALL MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat, ErrMsg ) - CALL MeshDestroy( RotInputTypeData%TowerMotion, ErrStat, ErrMsg ) - CALL MeshDestroy( RotInputTypeData%HubMotion, ErrStat, 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotInputTypeData%BladeMotion) ENDIF @@ -12599,18 +12901,31 @@ SUBROUTINE AD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_CopyInput - SUBROUTINE AD_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInput' + LOGICAL,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), ErrStat, ErrMsg ) + CALL AD_Destroyrotinputtype( InputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputData%rotors) ENDIF @@ -12933,20 +13248,35 @@ SUBROUTINE AD_CopyRotOutputType( SrcRotOutputTypeData, DstRotOutputTypeData, Ctr ENDIF END SUBROUTINE AD_CopyRotOutputType - SUBROUTINE AD_DestroyRotOutputType( RotOutputTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyRotOutputType( RotOutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotOutputType), INTENT(INOUT) :: RotOutputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotOutputType' + LOGICAL,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 = "" - CALL MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat, ErrMsg ) - CALL MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat, 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%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), ErrStat, ErrMsg ) + CALL MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotOutputTypeData%BladeLoad) ENDIF @@ -13410,18 +13740,31 @@ SUBROUTINE AD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE AD_CopyOutput - SUBROUTINE AD_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE AD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyOutput' + LOGICAL,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), ErrStat, ErrMsg ) + CALL AD_Destroyrotoutputtype( OutputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%rotors) ENDIF diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 4eabaad1b7..64e6a7d477 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -265,15 +265,27 @@ SUBROUTINE AFI_CopyUA_BL_Type( SrcUA_BL_TypeData, DstUA_BL_TypeData, CtrlCode, E 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 ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyUA_BL_Type' + LOGICAL,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 ) @@ -658,15 +670,27 @@ SUBROUTINE AFI_CopyUA_BL_Default_Type( SrcUA_BL_Default_TypeData, DstUA_BL_Defau 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 ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyUA_BL_Default_Type' + LOGICAL,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 ) @@ -1010,15 +1034,27 @@ SUBROUTINE AFI_CopyTable_Type( SrcTable_TypeData, DstTable_TypeData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AFI_CopyTable_Type - SUBROUTINE AFI_DestroyTable_Type( Table_TypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyTable_Type' + LOGICAL,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 @@ -1028,7 +1064,8 @@ SUBROUTINE AFI_DestroyTable_Type( Table_TypeData, ErrStat, ErrMsg ) IF (ALLOCATED(Table_TypeData%SplineCoefs)) THEN DEALLOCATE(Table_TypeData%SplineCoefs) ENDIF - CALL AFI_Destroyua_bl_type( Table_TypeData%UA_BL, ErrStat, ErrMsg ) + 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 ) @@ -1405,15 +1442,27 @@ SUBROUTINE AFI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%UA_f_cn = SrcInitInputData%UA_f_cn END SUBROUTINE AFI_CopyInitInput - SUBROUTINE AFI_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE AFI_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AFI_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInitInput' + LOGICAL,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 ) @@ -1571,16 +1620,29 @@ SUBROUTINE AFI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AFI_CopyInitOutput - SUBROUTINE AFI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE AFI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AFI_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInitOutput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 ) @@ -1843,15 +1905,27 @@ SUBROUTINE AFI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%FileName = SrcParamData%FileName END SUBROUTINE AFI_CopyParam - SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AFI_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyParam' + LOGICAL,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 @@ -1863,7 +1937,8 @@ SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%Table)) THEN DO i1 = LBOUND(ParamData%Table,1), UBOUND(ParamData%Table,1) - CALL AFI_Destroytable_type( ParamData%Table(i1), ErrStat, ErrMsg ) + CALL AFI_Destroytable_type( ParamData%Table(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%Table) ENDIF @@ -2289,15 +2364,27 @@ SUBROUTINE AFI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%Re = SrcInputData%Re END SUBROUTINE AFI_CopyInput - SUBROUTINE AFI_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE AFI_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AFI_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInput' + LOGICAL,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 ) @@ -2432,15 +2519,27 @@ SUBROUTINE AFI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%FullyAttached = SrcOutputData%FullyAttached END SUBROUTINE AFI_CopyOutput - SUBROUTINE AFI_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE AFI_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AFI_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyOutput' + LOGICAL,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 ) diff --git a/modules/aerodyn/src/BEMT.f90 b/modules/aerodyn/src/BEMT.f90 index be879948c5..096e36ad0b 100644 --- a/modules/aerodyn/src/BEMT.f90 +++ b/modules/aerodyn/src/BEMT.f90 @@ -352,22 +352,6 @@ subroutine BEMT_AllocInput( u, p, errStat, errMsg ) end if u%Vy = 0.0_ReKi - if (p%DBEMT_Mod==DBEMT_cont_tauConst) then - allocate ( u%Vx_elast_dot( p%numBladeNodes, p%numBlades ), STAT = errStat2 ) - if ( errStat2 /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Error allocating memory for u%Vx_dot.', errStat, errMsg, RoutineName ) - return - end if - u%Vx_elast_dot = 0.0_ReKi - - allocate ( u%Vy_elast_dot( p%numBladeNodes, p%numBlades ), STAT = errStat2 ) - if ( errStat2 /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Error allocating memory for u%Vy_dot.', errStat, errMsg, RoutineName ) - return - end if - u%Vy_elast_dot = 0.0_ReKi - end if - allocate ( u%omega_z( p%numBladeNodes, p%numBlades ), STAT = errStat2 ) if ( errStat2 /= 0 ) then call SetErrStat( ErrID_Fatal, 'Error allocating memory for u%omega_z.', errStat, errMsg, RoutineName ) @@ -936,15 +920,6 @@ subroutine SetInputs_For_DBEMT(u_DBEMT, u, p, axInduction, tanInduction, Rtip) end do end do - if( allocated(u%Vx_elast_dot)) then ! only for DBEMT_Mod=DBEMT_cont_tauConst - do j = 1,p%numBlades - do i = 1,p%numBladeNodes - u_DBEMT%element(i,j)%vind_s_dot(1) = axInduction( i,j)*u%Vx_elast_dot(i,j) - u%omega_z(i,j)*tanInduction(i,j)*u%Vy(i,j) ! Eq. 41 - u_DBEMT%element(i,j)%vind_s_dot(2) = -tanInduction(i,j)*u%Vy_elast_dot(i,j) - u%omega_z(i,j)*axInduction( i,j)*u%Vx(i,j) ! Eq. 41 - end do - end do - end if - end subroutine SetInputs_For_DBEMT !.................................................................................................................................. @@ -1139,9 +1114,9 @@ subroutine check_turnOffBEMT(p, u, Weight, axInduction, tanInduction, FirstWarn) integer(IntKi) :: i !< blade node counter integer(IntKi) :: j !< blade counter - if( u%TSR < BEMT_upperBoundTSR ) then + if( abs(u%TSR) < BEMT_upperBoundTSR ) then - Weight = BlendCosine( u%TSR, BEMT_lowerBoundTSR, BEMT_upperBoundTSR ) + Weight = BlendCosine( abs(u%TSR), BEMT_lowerBoundTSR, BEMT_upperBoundTSR ) if (FirstWarn) then if (Weight < 1.0_ReKi) then @@ -2286,7 +2261,6 @@ subroutine WriteDEBUGValuesToFile(t, u, p, x, xd, z, OtherState, m, AFInfo) , "omega_z" & , "rLocal" , "UserProp" & , "AxInd", "TanInd" -! , "Vx_elast_dot" , "Vy_elast_dot" & end if @@ -2312,9 +2286,6 @@ subroutine WriteDEBUGValuesToFile(t, u, p, x, xd, z, OtherState, m, AFInfo) , u%UserProp( DEBUG_BLADENODE,DEBUG_BLADE) & , m%axInduction( DEBUG_BLADENODE,DEBUG_BLADE) & , m%tanInduction(DEBUG_BLADENODE,DEBUG_BLADE) -! these are not always allocated -! , u%Vx_elast_dot(DEBUG_BLADENODE,DEBUG_BLADE) & -! , u%Vy_elast_dot(DEBUG_BLADENODE,DEBUG_BLADE) & ! now write the residual function to a separate file: if ((DEBUG_nStep >= 0).AND.(DEBUG_nStep <= 450000).AND.(MOD(DEBUG_nStep,25) == 0)) then diff --git a/modules/aerodyn/src/BEMT_Registry.txt b/modules/aerodyn/src/BEMT_Registry.txt index 73b2d2cd4d..5c68c3bca9 100644 --- a/modules/aerodyn/src/BEMT_Registry.txt +++ b/modules/aerodyn/src/BEMT_Registry.txt @@ -47,6 +47,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi zLocal {:}{:} - - "Distance to blade node, measured along the blade" m 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)" 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'' " - @@ -154,8 +155,6 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi TSR - - - "Tip-speed ratio (to check if BEM should be turned off)" - typedef ^ ^ ReKi Vx {:}{:} - - "Local axial velocity at node" m/s typedef ^ ^ ReKi Vy {:}{:} - - "Local tangential velocity at node" m/s -typedef ^ ^ ReKi Vx_elast_dot {:}{:} - - "Local relative axial acceleration at node (for CDBEMT)" "m/s^2" -typedef ^ ^ ReKi Vy_elast_dot {:}{:} - - "Local relative tangential acceleration at node (for CDBEMT)" "m/s^2" typedef ^ ^ ReKi omega_z {:}{:} - - "rotation of no-sweep-pitch-twist coordinate system around z (for CDBEMT and CUA)" "rad/s" typedef ^ ^ ReKi rLocal {:}{:} - - "Radial distance from center-of-rotation to node" m typedef ^ InputType ReKi Un_disk - - - "disk-averaged velocity normal to the rotor disk (for input to DBEMT)" m/s diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index d7dd816ca9..a9be8c1469 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -57,6 +57,7 @@ MODULE BEMT_Types 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) [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'' [-] @@ -160,8 +161,6 @@ MODULE BEMT_Types REAL(ReKi) :: TSR !< 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 :: Vx_elast_dot !< Local relative axial acceleration at node (for CDBEMT) [m/s^2] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vy_elast_dot !< Local relative tangential acceleration at node (for CDBEMT) [m/s^2] 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 :: 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] @@ -296,6 +295,18 @@ SUBROUTINE BEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err 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 @@ -332,15 +343,27 @@ SUBROUTINE BEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%SumPrint = SrcInitInputData%SumPrint END SUBROUTINE BEMT_CopyInitInput - SUBROUTINE BEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE BEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BEMT_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInitInput' + LOGICAL,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 @@ -359,6 +382,9 @@ SUBROUTINE BEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) 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 @@ -445,6 +471,11 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM 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 @@ -629,6 +660,21 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM 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 @@ -866,6 +912,24 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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 @@ -944,16 +1008,29 @@ SUBROUTINE BEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE BEMT_CopyInitOutput - SUBROUTINE BEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE BEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BEMT_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInitOutput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Version, ErrStat, 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 ) @@ -1156,17 +1233,31 @@ SUBROUTINE BEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE BEMT_CopyContState - SUBROUTINE BEMT_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE BEMT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BEMT_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyContState' + LOGICAL,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 = "" - CALL UA_DestroyContState( ContStateData%UA, ErrStat, ErrMsg ) - CALL DBEMT_DestroyContState( ContStateData%DBEMT, ErrStat, 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 ) @@ -1451,16 +1542,29 @@ SUBROUTINE BEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE BEMT_CopyDiscState - SUBROUTINE BEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE BEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BEMT_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyDiscState' + LOGICAL,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 = "" - CALL UA_DestroyDiscState( DiscStateData%UA, ErrStat, 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 ) @@ -1673,15 +1777,27 @@ SUBROUTINE BEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod ENDIF END SUBROUTINE BEMT_CopyConstrState - SUBROUTINE BEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE BEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BEMT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyConstrState' + LOGICAL,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 @@ -1868,17 +1984,31 @@ SUBROUTINE BEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized END SUBROUTINE BEMT_CopyOtherState - SUBROUTINE BEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE BEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BEMT_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyOtherState' + LOGICAL,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 = "" - CALL UA_DestroyOtherState( OtherStateData%UA, ErrStat, ErrMsg ) - CALL DBEMT_DestroyOtherState( OtherStateData%DBEMT, ErrStat, 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 @@ -2385,23 +2515,39 @@ SUBROUTINE BEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%BEM_weight = SrcMiscData%BEM_weight END SUBROUTINE BEMT_CopyMisc - SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BEMT_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyMisc' + LOGICAL,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 = "" - CALL UA_DestroyMisc( MiscData%UA, ErrStat, ErrMsg ) - CALL DBEMT_DestroyMisc( MiscData%DBEMT, ErrStat, ErrMsg ) - CALL UA_DestroyOutput( MiscData%y_UA, ErrStat, 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), ErrStat, ErrMsg ) + CALL UA_DestroyInput( MiscData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO ENDDO @@ -2409,7 +2555,8 @@ SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(MiscData%u_DBEMT)) THEN DO i1 = LBOUND(MiscData%u_DBEMT,1), UBOUND(MiscData%u_DBEMT,1) - CALL DBEMT_DestroyInput( MiscData%u_DBEMT(i1), ErrStat, ErrMsg ) + CALL DBEMT_DestroyInput( MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%u_DBEMT) ENDIF @@ -3577,15 +3724,27 @@ SUBROUTINE BEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE BEMT_CopyParam - SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BEMT_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyParam' + LOGICAL,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 @@ -3601,8 +3760,10 @@ SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%zHub)) THEN DEALLOCATE(ParamData%zHub) ENDIF - CALL UA_DestroyParam( ParamData%UA, ErrStat, ErrMsg ) - CALL DBEMT_DestroyParam( ParamData%DBEMT, ErrStat, ErrMsg ) + 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 @@ -4314,34 +4475,6 @@ SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg END IF DstInputData%Vy = SrcInputData%Vy ENDIF -IF (ALLOCATED(SrcInputData%Vx_elast_dot)) THEN - i1_l = LBOUND(SrcInputData%Vx_elast_dot,1) - i1_u = UBOUND(SrcInputData%Vx_elast_dot,1) - i2_l = LBOUND(SrcInputData%Vx_elast_dot,2) - i2_u = UBOUND(SrcInputData%Vx_elast_dot,2) - IF (.NOT. ALLOCATED(DstInputData%Vx_elast_dot)) THEN - ALLOCATE(DstInputData%Vx_elast_dot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vx_elast_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vx_elast_dot = SrcInputData%Vx_elast_dot -ENDIF -IF (ALLOCATED(SrcInputData%Vy_elast_dot)) THEN - i1_l = LBOUND(SrcInputData%Vy_elast_dot,1) - i1_u = UBOUND(SrcInputData%Vy_elast_dot,1) - i2_l = LBOUND(SrcInputData%Vy_elast_dot,2) - i2_u = UBOUND(SrcInputData%Vy_elast_dot,2) - IF (.NOT. ALLOCATED(DstInputData%Vy_elast_dot)) THEN - ALLOCATE(DstInputData%Vy_elast_dot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vy_elast_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vy_elast_dot = SrcInputData%Vy_elast_dot -ENDIF IF (ALLOCATED(SrcInputData%omega_z)) THEN i1_l = LBOUND(SrcInputData%omega_z,1) i1_u = UBOUND(SrcInputData%omega_z,1) @@ -4387,15 +4520,27 @@ SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE BEMT_CopyInput - SUBROUTINE BEMT_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE BEMT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BEMT_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInput' + LOGICAL,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 @@ -4408,12 +4553,6 @@ SUBROUTINE BEMT_DestroyInput( InputData, ErrStat, ErrMsg ) IF (ALLOCATED(InputData%Vy)) THEN DEALLOCATE(InputData%Vy) ENDIF -IF (ALLOCATED(InputData%Vx_elast_dot)) THEN - DEALLOCATE(InputData%Vx_elast_dot) -ENDIF -IF (ALLOCATED(InputData%Vy_elast_dot)) THEN - DEALLOCATE(InputData%Vy_elast_dot) -ENDIF IF (ALLOCATED(InputData%omega_z)) THEN DEALLOCATE(InputData%omega_z) ENDIF @@ -4483,16 +4622,6 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 ! Vx_elast_dot allocated yes/no - IF ( ALLOCATED(InData%Vx_elast_dot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vx_elast_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_elast_dot) ! Vx_elast_dot - END IF - Int_BufSz = Int_BufSz + 1 ! Vy_elast_dot allocated yes/no - IF ( ALLOCATED(InData%Vy_elast_dot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vy_elast_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy_elast_dot) ! Vy_elast_dot - 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 @@ -4617,46 +4746,6 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%Vx_elast_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%Vx_elast_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_elast_dot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_elast_dot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_elast_dot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vx_elast_dot,2), UBOUND(InData%Vx_elast_dot,2) - DO i1 = LBOUND(InData%Vx_elast_dot,1), UBOUND(InData%Vx_elast_dot,1) - ReKiBuf(Re_Xferred) = InData%Vx_elast_dot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy_elast_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%Vy_elast_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_elast_dot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_elast_dot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_elast_dot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vy_elast_dot,2), UBOUND(InData%Vy_elast_dot,2) - DO i1 = LBOUND(InData%Vy_elast_dot,1), UBOUND(InData%Vy_elast_dot,1) - ReKiBuf(Re_Xferred) = InData%Vy_elast_dot(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 @@ -4842,52 +4931,6 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_elast_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%Vx_elast_dot)) DEALLOCATE(OutData%Vx_elast_dot) - ALLOCATE(OutData%Vx_elast_dot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_elast_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vx_elast_dot,2), UBOUND(OutData%Vx_elast_dot,2) - DO i1 = LBOUND(OutData%Vx_elast_dot,1), UBOUND(OutData%Vx_elast_dot,1) - OutData%Vx_elast_dot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy_elast_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%Vy_elast_dot)) DEALLOCATE(OutData%Vy_elast_dot) - ALLOCATE(OutData%Vy_elast_dot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_elast_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vy_elast_dot,2), UBOUND(OutData%Vy_elast_dot,2) - DO i1 = LBOUND(OutData%Vy_elast_dot,1), UBOUND(OutData%Vy_elast_dot,1) - OutData%Vy_elast_dot(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 @@ -5161,15 +5204,27 @@ SUBROUTINE BEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE BEMT_CopyOutput - SUBROUTINE BEMT_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE BEMT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BEMT_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyOutput' + LOGICAL,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 @@ -6062,22 +6117,6 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg END DO END DO END IF ! check if allocated -IF (ALLOCATED(u_out%Vx_elast_dot) .AND. ALLOCATED(u1%Vx_elast_dot)) THEN - DO i2 = LBOUND(u_out%Vx_elast_dot,2),UBOUND(u_out%Vx_elast_dot,2) - DO i1 = LBOUND(u_out%Vx_elast_dot,1),UBOUND(u_out%Vx_elast_dot,1) - b = -(u1%Vx_elast_dot(i1,i2) - u2%Vx_elast_dot(i1,i2)) - u_out%Vx_elast_dot(i1,i2) = u1%Vx_elast_dot(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vy_elast_dot) .AND. ALLOCATED(u1%Vy_elast_dot)) THEN - DO i2 = LBOUND(u_out%Vy_elast_dot,2),UBOUND(u_out%Vy_elast_dot,2) - DO i1 = LBOUND(u_out%Vy_elast_dot,1),UBOUND(u_out%Vy_elast_dot,1) - b = -(u1%Vy_elast_dot(i1,i2) - u2%Vy_elast_dot(i1,i2)) - u_out%Vy_elast_dot(i1,i2) = u1%Vy_elast_dot(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) @@ -6206,24 +6245,6 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er END DO END DO END IF ! check if allocated -IF (ALLOCATED(u_out%Vx_elast_dot) .AND. ALLOCATED(u1%Vx_elast_dot)) THEN - DO i2 = LBOUND(u_out%Vx_elast_dot,2),UBOUND(u_out%Vx_elast_dot,2) - DO i1 = LBOUND(u_out%Vx_elast_dot,1),UBOUND(u_out%Vx_elast_dot,1) - b = (t(3)**2*(u1%Vx_elast_dot(i1,i2) - u2%Vx_elast_dot(i1,i2)) + t(2)**2*(-u1%Vx_elast_dot(i1,i2) + u3%Vx_elast_dot(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Vx_elast_dot(i1,i2) + t(3)*u2%Vx_elast_dot(i1,i2) - t(2)*u3%Vx_elast_dot(i1,i2) ) * scaleFactor - u_out%Vx_elast_dot(i1,i2) = u1%Vx_elast_dot(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vy_elast_dot) .AND. ALLOCATED(u1%Vy_elast_dot)) THEN - DO i2 = LBOUND(u_out%Vy_elast_dot,2),UBOUND(u_out%Vy_elast_dot,2) - DO i1 = LBOUND(u_out%Vy_elast_dot,1),UBOUND(u_out%Vy_elast_dot,1) - b = (t(3)**2*(u1%Vy_elast_dot(i1,i2) - u2%Vy_elast_dot(i1,i2)) + t(2)**2*(-u1%Vy_elast_dot(i1,i2) + u3%Vy_elast_dot(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Vy_elast_dot(i1,i2) + t(3)*u2%Vy_elast_dot(i1,i2) - t(2)*u3%Vy_elast_dot(i1,i2) ) * scaleFactor - u_out%Vy_elast_dot(i1,i2) = u1%Vy_elast_dot(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) diff --git a/modules/aerodyn/src/DBEMT.f90 b/modules/aerodyn/src/DBEMT.f90 index 4d3eae6a17..3c12e5c3b4 100644 --- a/modules/aerodyn/src/DBEMT.f90 +++ b/modules/aerodyn/src/DBEMT.f90 @@ -17,6 +17,14 @@ ! See the License for the specific language governing permissions and ! limitations under the License. !********************************************************************************************************************************** +! +! References: +! [1] E. Branlard, B. Jonkman, G.R. Pirrung, K. Dixon, J. Jonkman (2022) +! Dynamic inflow and unsteady aerodynamics models for modal and stability analyses in OpenFAST, +! Journal of Physics: Conference Series, doi:10.1088/1742-6596/2265/3/032044 +! [2] R. Damiani, J.Jonkman +! DBEMT Theory Rev. 3 +! Unpublished module DBEMT use NWTC_Library @@ -208,7 +216,7 @@ subroutine DBEMT_Init( InitInp, u, p, x, OtherState, m, Interval, InitOut, ErrSt end if end do - p%lin_nx = p%numNodes*p%numBlades*4 ! vind and vind_dot + p%lin_nx = p%numNodes*p%numBlades*4 ! vind and vind_1 else p%lin_nx = 0 end if @@ -241,9 +249,8 @@ subroutine DBEMT_ReInit( p, x, OtherState, m ) do j=1,size(x%element,2) do i=1,size(x%element,1) - x%element(i,j)%vind = 0.0_ReKi - x%element(i,j)%vind_dot = 0.0_ReKi - x%element(i,j)%vind_1 = 0.0_ReKi + x%element(i,j)%vind = 0.0_ReKi ! Dynamic induced velocities + x%element(i,j)%vind_1 = 0.0_ReKi ! Reduced induced velocities end do end do @@ -306,10 +313,10 @@ subroutine DBEMT_InitStates( i, j, u, p, x, OtherState ) x%element(i,j)%vind(2) = u%element(i,j)%vind_s(2) if (p%DBEMT_Mod == DBEMT_cont_tauConst) then - x%element(i,j)%vind_dot(1) = u%element(i,j)%vind_s_dot(1) - x%element(i,j)%vind_dot(2) = u%element(i,j)%vind_s_dot(2) + x%element(i,j)%vind_1(1) = (1._ReKi - p%k_0ye)*u%element(i,j)%vind_s(1) ! Reduced velocity. Eq. (6) from [1] + x%element(i,j)%vind_1(2) = (1._ReKi - p%k_0ye)*u%element(i,j)%vind_s(2) else - x%element(i,j)%vind_1(1) = u%element(i,j)%vind_s(1) + x%element(i,j)%vind_1(1) = u%element(i,j)%vind_s(1) ! Intermediate velocity x%element(i,j)%vind_1(2) = u%element(i,j)%vind_s(2) end if @@ -455,7 +462,7 @@ subroutine ComputeTau1(u, p, m, tau1, errStat, errMsg) temp = (1.0-1.3*AxInd_disk)*Un_disk - tau1 = 1.1*u%R_disk/temp ! Eqn. 1.2 (note that we've eliminated possibility of temp being 0) + tau1 = 1.1*u%R_disk/temp ! Eq. (1) from [1] (note that we've eliminated possibility of temp being 0) tau1 = min(tau1, 100.0_ReKi) ! put a limit on this time constant so it isn't unrealistically long (particularly at initialization) end if @@ -484,8 +491,8 @@ subroutine ComputeTau2(i, j, u, p, tau1, tau2, k_tau_out) spanRatio = u%spanRatio end if - k_tau = 0.39 - 0.26*spanRatio**2 ! Eqn. 1.23b - tau2 = k_tau*tau1 ! Eqn. 1.7 or Eqn 1.23a + k_tau = 0.39 - 0.26*spanRatio**2 + tau2 = k_tau*tau1 ! Eq. (1) from [1] if (present(k_tau_out) ) k_tau_out = k_tau @@ -552,7 +559,8 @@ SUBROUTINE DBEMT_CalcContStateDeriv( i, j, t, u, p, x, OtherState, m, dxdt, ErrS ! LOCAL variables CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CalcContStateDeriv' - REAL(ReKi) :: tauConst + REAL(ReKi) :: tau1inv + REAL(ReKi) :: tau2inv REAL(ReKi) :: tau1 REAL(ReKi) :: tau2 @@ -567,20 +575,15 @@ SUBROUTINE DBEMT_CalcContStateDeriv( i, j, t, u, p, x, OtherState, m, dxdt, ErrS call SetErrStat(ErrID_Fatal,"Continuous state derivatives cannot be calculated unless DBEMT_Mod is 3.",ErrStat,ErrMsg,RoutineName) return end if - tau1 = p%tau1_const - !call ComputeTau1( u, p, m, tau1, errStat, errMsg) call ComputeTau2(i, j, u, p, tau1, tau2) - - ! Implement Equation 37 from E.Branlard 16-Dec-2019 doc: + tau1inv = 1.0_ReKi/(tau1) + tau2inv = 1.0_ReKi/(tau2) - dxdt%vind = x%vind_dot - - tauConst = -1.0_ReKi/(tau1 * tau2) - - dxdt%vind_dot = tauConst * ( x%vind(:) + (tau1 + tau2)*x%vind_dot(:) & - - u%vind_s(:) - p%k_0ye*tau1*u%vind_s_dot(:) ) - + ! State derivatives, Eq. (7) from [1] + dxdt%vind_1 = -tau1inv * x%vind_1(:) + (1 - p%k_0ye) * tau1inv * u%vind_s(:) + dxdt%vind = tau2inv * x%vind_1(:) - tau2inv * x%vind(:) + p%k_0ye * tau2inv * u%vind_s(:) + END SUBROUTINE DBEMT_CalcContStateDeriv !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine implements the fourth-order Runge-Kutta Method (RK4) for numerically integrating ordinary differential equations: @@ -652,11 +655,11 @@ SUBROUTINE DBEMT_RK4( i, j, t, n, u, utimes, p, x, OtherState, m, ErrStat, ErrMs IF ( ErrStat >= AbortErrLev ) RETURN - k1%vind = p%dt * k1%vind - k1%vind_dot = p%dt * k1%vind_dot + k1%vind = p%dt * k1%vind + k1%vind_1 = p%dt * k1%vind_1 - x_tmp%vind = x%element(i,j)%vind + 0.5 * k1%vind - x_tmp%vind_dot = x%element(i,j)%vind_dot + 0.5 * k1%vind_dot + x_tmp%vind = x%element(i,j)%vind + 0.5 * k1%vind + x_tmp%vind_1 = x%element(i,j)%vind_1 + 0.5 * k1%vind_1 ! interpolate u to find u_interp = u(t + dt/2) TPlusHalfDt = t+0.5_DbKi*p%dt @@ -667,20 +670,20 @@ SUBROUTINE DBEMT_RK4( i, j, t, n, u, utimes, p, x, OtherState, m, ErrStat, ErrMs ! find xdot at t + dt/2 CALL DBEMT_CalcContStateDeriv( i, j, TPlusHalfDt, u_interp, p, x_tmp, OtherState, m, k2, ErrStat2, ErrMsg2 ) - k2%vind = p%dt * k2%vind - k2%vind_dot = p%dt * k2%vind_dot + k2%vind = p%dt * k2%vind + k2%vind_1 = p%dt * k2%vind_1 - x_tmp%vind = x%element(i,j)%vind + 0.5 * k2%vind - x_tmp%vind_dot = x%element(i,j)%vind_dot + 0.5 * k2%vind_dot + x_tmp%vind = x%element(i,j)%vind + 0.5 * k2%vind + x_tmp%vind_1 = x%element(i,j)%vind_1 + 0.5 * k2%vind_1 ! find xdot at t + dt/2 (note x_tmp has changed) CALL DBEMT_CalcContStateDeriv( i, j, TPlusHalfDt, u_interp, p, x_tmp, OtherState, m, k3, ErrStat2, ErrMsg2 ) - k3%vind = p%dt * k3%vind - k3%vind_dot = p%dt * k3%vind_dot + k3%vind = p%dt * k3%vind + k3%vind_1 = p%dt * k3%vind_1 - x_tmp%vind = x%element(i,j)%vind + k3%vind - x_tmp%vind_dot = x%element(i,j)%vind_dot + k3%vind_dot + x_tmp%vind = x%element(i,j)%vind + k3%vind + x_tmp%vind_1 = x%element(i,j)%vind_1 + k3%vind_1 ! interpolate u to find u_interp = u(t + dt) TPlusDt = t + p%dt @@ -691,11 +694,11 @@ SUBROUTINE DBEMT_RK4( i, j, t, n, u, utimes, p, x, OtherState, m, ErrStat, ErrMs ! find xdot at t + dt CALL DBEMT_CalcContStateDeriv( i, j, TPlusDt, u_interp, p, x_tmp, OtherState, m, k4, ErrStat2, ErrMsg2 ) - k4%vind = p%dt * k4%vind - k4%vind_dot = p%dt * k4%vind_dot + k4%vind = p%dt * k4%vind + k4%vind_1 = p%dt * k4%vind_1 - x%element(i,j)%vind = x%element(i,j)%vind + ( k1%vind + 2. * k2%vind + 2. * k3%vind + k4%vind ) / 6. - x%element(i,j)%vind_dot = x%element(i,j)%vind_dot + ( k1%vind_dot + 2. * k2%vind_dot + 2. * k3%vind_dot + k4%vind_dot ) / 6. + x%element(i,j)%vind = x%element(i,j)%vind + ( k1%vind + 2. * k2%vind + 2. * k3%vind + k4%vind ) / 6. + x%element(i,j)%vind_1 = x%element(i,j)%vind_1 + ( k1%vind_1 + 2. * k2%vind_1 + 2. * k3%vind_1 + k4%vind_1 ) / 6. END SUBROUTINE DBEMT_RK4 !---------------------------------------------------------------------------------------------------------------------------------- @@ -779,11 +782,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 & + 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_dot = x%element(i,j)%vind_dot + p%DT/24. * ( 55.*OtherState%xdot(1)%element(i,j)%vind_dot - 59.*OtherState%xdot(2)%element(i,j)%vind_dot & - + 37.*OtherState%xdot(3)%element(i,j)%vind_dot - 9.*OtherState%xdot(4)%element(i,j)%vind_dot ) + 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 @@ -861,13 +864,13 @@ SUBROUTINE DBEMT_ABM4( i, j, t, n, u, utimes, p, x, OtherState, m, ErrStat, ErrM IF ( ErrStat >= AbortErrLev ) RETURN - x%element(i,j)%vind = x_in%vind + p%DT/24. * ( 9. * xdot_pred%vind + 19. * OtherState%xdot(1)%element(i,j)%vind & + 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 ) - x%element(i,j)%vind_dot = x_in%vind_dot + p%DT/24. * ( 9. * xdot_pred%vind_dot + 19. * OtherState%xdot(1)%element(i,j)%vind_dot & - - 5. * OtherState%xdot(2)%element(i,j)%vind_dot & - + 1. * OtherState%xdot(3)%element(i,j)%vind_dot ) + 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 ) endif END SUBROUTINE DBEMT_ABM4 @@ -921,4 +924,4 @@ subroutine DBEMT_End( u, p, x, OtherState, m, ErrStat, ErrMsg ) END SUBROUTINE DBEMT_End -end module DBEMT \ No newline at end of file +end module DBEMT diff --git a/modules/aerodyn/src/DBEMT_Registry.txt b/modules/aerodyn/src/DBEMT_Registry.txt index c5fa20f529..21a726a068 100644 --- a/modules/aerodyn/src/DBEMT_Registry.txt +++ b/modules/aerodyn/src/DBEMT_Registry.txt @@ -29,8 +29,7 @@ typedef ^ ^ ReKi rLocal { typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ DBEMT_ElementContinuousStateType R8Ki vind {2} - - "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 -typedef ^ DBEMT_ElementContinuousStateType R8Ki vind_dot {2} - - "Time derivative of the filtered induced velocity, x%vind in CCSD" "m/s^2" -typedef ^ DBEMT_ElementContinuousStateType R8Ki vind_1 {2} - - "The filtered intermediate induced velocity" "m/s" +typedef ^ DBEMT_ElementContinuousStateType R8Ki vind_1 {2} - - "The filtered reduced or intermediate induced velocity" "m/s" # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -73,7 +72,6 @@ typedef ^ ParameterType IntKi DBEMT_Mod # ..... Inputs .................................................................................................................... typedef ^ DBEMT_ElementInputType ReKi vind_s {2} - - "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" -typedef ^ DBEMT_ElementInputType ReKi vind_s_dot {2} - - "The first time derivative of the unfiltered induced velocity, u%vind_s" "m/s^2" typedef ^ DBEMT_ElementInputType ReKi spanRatio - - - "Normalized span location of blade node" - # Define inputs that are contained on the mesh here: # diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 04f0fb3af0..423dd42b0b 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -54,8 +54,7 @@ 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_dot !< Time derivative of the filtered induced velocity, x%vind in CCSD [m/s^2] - REAL(R8Ki) , DIMENSION(1:2) :: vind_1 !< The filtered intermediate induced velocity [m/s] + REAL(R8Ki) , DIMENSION(1:2) :: vind_1 !< The filtered reduced or intermediate induced velocity [m/s] END TYPE DBEMT_ElementContinuousStateType ! ======================= ! ========= DBEMT_ContinuousStateType ======= @@ -102,7 +101,6 @@ MODULE DBEMT_Types ! ========= 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) , DIMENSION(1:2) :: vind_s_dot !< The first time derivative of the unfiltered induced velocity, u%vind_s [m/s^2] REAL(ReKi) :: spanRatio !< Normalized span location of blade node [-] END TYPE DBEMT_ElementInputType ! ======================= @@ -157,15 +155,27 @@ SUBROUTINE DBEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er ENDIF END SUBROUTINE DBEMT_CopyInitInput - SUBROUTINE DBEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInitInput' + LOGICAL,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 @@ -353,16 +363,29 @@ SUBROUTINE DBEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DBEMT_CopyInitOutput - SUBROUTINE DBEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInitOutput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 ) @@ -559,19 +582,30 @@ SUBROUTINE DBEMT_CopyElementContinuousStateType( SrcElementContinuousStateTypeDa ErrStat = ErrID_None ErrMsg = "" DstElementContinuousStateTypeData%vind = SrcElementContinuousStateTypeData%vind - DstElementContinuousStateTypeData%vind_dot = SrcElementContinuousStateTypeData%vind_dot DstElementContinuousStateTypeData%vind_1 = SrcElementContinuousStateTypeData%vind_1 END SUBROUTINE DBEMT_CopyElementContinuousStateType - SUBROUTINE DBEMT_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_ElementContinuousStateType), INTENT(INOUT) :: ElementContinuousStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyElementContinuousStateType' + LOGICAL,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 ) @@ -610,7 +644,6 @@ SUBROUTINE DBEMT_PackElementContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Ind Db_BufSz = 0 Int_BufSz = 0 Db_BufSz = Db_BufSz + SIZE(InData%vind) ! vind - Db_BufSz = Db_BufSz + SIZE(InData%vind_dot) ! vind_dot Db_BufSz = Db_BufSz + SIZE(InData%vind_1) ! vind_1 IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -643,10 +676,6 @@ SUBROUTINE DBEMT_PackElementContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Ind DbKiBuf(Db_Xferred) = InData%vind(i1) Db_Xferred = Db_Xferred + 1 END DO - DO i1 = LBOUND(InData%vind_dot,1), UBOUND(InData%vind_dot,1) - DbKiBuf(Db_Xferred) = InData%vind_dot(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 @@ -686,12 +715,6 @@ SUBROUTINE DBEMT_UnPackElementContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, O OutData%vind(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) Db_Xferred = Db_Xferred + 1 END DO - i1_l = LBOUND(OutData%vind_dot,1) - i1_u = UBOUND(OutData%vind_dot,1) - DO i1 = LBOUND(OutData%vind_dot,1), UBOUND(OutData%vind_dot,1) - OutData%vind_dot(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) @@ -738,19 +761,32 @@ SUBROUTINE DBEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Er ENDIF END SUBROUTINE DBEMT_CopyContState - SUBROUTINE DBEMT_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyContState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL DBEMT_Destroyelementcontinuousstatetype( ContStateData%element(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO DEALLOCATE(ContStateData%element) @@ -1001,15 +1037,27 @@ SUBROUTINE DBEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Er DstDiscStateData%DummyState = SrcDiscStateData%DummyState END SUBROUTINE DBEMT_CopyDiscState - SUBROUTINE DBEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyDiscState' + LOGICAL,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 ) @@ -1126,15 +1174,27 @@ SUBROUTINE DBEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCo DstConstrStateData%DummyState = SrcConstrStateData%DummyState END SUBROUTINE DBEMT_CopyConstrState - SUBROUTINE DBEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyConstrState' + LOGICAL,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 ) @@ -1287,15 +1347,27 @@ SUBROUTINE DBEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ENDDO END SUBROUTINE DBEMT_CopyOtherState - SUBROUTINE DBEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyOtherState' + LOGICAL,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 @@ -1303,7 +1375,8 @@ SUBROUTINE DBEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) DEALLOCATE(OtherStateData%n) ENDIF DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL DBEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat, ErrMsg ) + CALL DBEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO END SUBROUTINE DBEMT_DestroyOtherState @@ -1618,15 +1691,27 @@ SUBROUTINE DBEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%FirstWarn_tau1 = SrcMiscData%FirstWarn_tau1 END SUBROUTINE DBEMT_CopyMisc - SUBROUTINE DBEMT_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyMisc' + LOGICAL,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 ) @@ -1765,15 +1850,27 @@ SUBROUTINE DBEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod END SUBROUTINE DBEMT_CopyParam - SUBROUTINE DBEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyParam' + LOGICAL,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 @@ -1972,19 +2069,30 @@ SUBROUTINE DBEMT_CopyElementInputType( SrcElementInputTypeData, DstElementInputT ErrStat = ErrID_None ErrMsg = "" DstElementInputTypeData%vind_s = SrcElementInputTypeData%vind_s - DstElementInputTypeData%vind_s_dot = SrcElementInputTypeData%vind_s_dot DstElementInputTypeData%spanRatio = SrcElementInputTypeData%spanRatio END SUBROUTINE DBEMT_CopyElementInputType - SUBROUTINE DBEMT_DestroyElementInputType( ElementInputTypeData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyElementInputType( ElementInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: ElementInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyElementInputType' + LOGICAL,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 ) @@ -2023,7 +2131,6 @@ SUBROUTINE DBEMT_PackElementInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_BufSz = 0 Int_BufSz = 0 Re_BufSz = Re_BufSz + SIZE(InData%vind_s) ! vind_s - Re_BufSz = Re_BufSz + SIZE(InData%vind_s_dot) ! vind_s_dot Re_BufSz = Re_BufSz + 1 ! spanRatio IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -2056,10 +2163,6 @@ SUBROUTINE DBEMT_PackElementInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt ReKiBuf(Re_Xferred) = InData%vind_s(i1) Re_Xferred = Re_Xferred + 1 END DO - DO i1 = LBOUND(InData%vind_s_dot,1), UBOUND(InData%vind_s_dot,1) - ReKiBuf(Re_Xferred) = InData%vind_s_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO ReKiBuf(Re_Xferred) = InData%spanRatio Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackElementInputType @@ -2097,12 +2200,6 @@ SUBROUTINE DBEMT_UnPackElementInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er OutData%vind_s(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO - i1_l = LBOUND(OutData%vind_s_dot,1) - i1_u = UBOUND(OutData%vind_s_dot,1) - DO i1 = LBOUND(OutData%vind_s_dot,1), UBOUND(OutData%vind_s_dot,1) - OutData%vind_s_dot(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 @@ -2148,19 +2245,32 @@ SUBROUTINE DBEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE DBEMT_CopyInput - SUBROUTINE DBEMT_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInput' + LOGICAL,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), ErrStat, ErrMsg ) + CALL DBEMT_Destroyelementinputtype( InputData%element(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO DEALLOCATE(InputData%element) @@ -2444,15 +2554,27 @@ SUBROUTINE DBEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er ENDIF END SUBROUTINE DBEMT_CopyOutput - SUBROUTINE DBEMT_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE DBEMT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DBEMT_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyOutput' + LOGICAL,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 @@ -2710,10 +2832,6 @@ SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, Err b = -(u1%vind_s(i1) - u2%vind_s(i1)) u_out%vind_s(i1) = u1%vind_s(i1) + b * ScaleFactor END DO - DO i1 = LBOUND(u_out%vind_s_dot,1),UBOUND(u_out%vind_s_dot,1) - b = -(u1%vind_s_dot(i1) - u2%vind_s_dot(i1)) - u_out%vind_s_dot(i1) = u1%vind_s_dot(i1) + b * ScaleFactor - END DO b = -(u1%spanRatio - u2%spanRatio) u_out%spanRatio = u1%spanRatio + b * ScaleFactor END SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1 @@ -2778,11 +2896,6 @@ SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, 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 - DO i1 = LBOUND(u_out%vind_s_dot,1),UBOUND(u_out%vind_s_dot,1) - b = (t(3)**2*(u1%vind_s_dot(i1) - u2%vind_s_dot(i1)) + t(2)**2*(-u1%vind_s_dot(i1) + u3%vind_s_dot(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%vind_s_dot(i1) + t(3)*u2%vind_s_dot(i1) - t(2)*u3%vind_s_dot(i1) ) * scaleFactor - u_out%vind_s_dot(i1) = u1%vind_s_dot(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 @@ -2902,14 +3015,6 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs 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) - DO i1 = LBOUND(u_out%element(i01,i02)%vind_s_dot,1),UBOUND(u_out%element(i01,i02)%vind_s_dot,1) - b = -(u1%element(i01,i02)%vind_s_dot(i1) - u2%element(i01,i02)%vind_s_dot(i1)) - u_out%element(i01,i02)%vind_s_dot(i1) = u1%element(i01,i02)%vind_s_dot(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 @@ -2995,15 +3100,6 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E 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) - DO i1 = LBOUND(u_out%element(i01,i02)%vind_s_dot,1),UBOUND(u_out%element(i01,i02)%vind_s_dot,1) - b = (t(3)**2*(u1%element(i01,i02)%vind_s_dot(i1) - u2%element(i01,i02)%vind_s_dot(i1)) + t(2)**2*(-u1%element(i01,i02)%vind_s_dot(i1) + u3%element(i01,i02)%vind_s_dot(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%element(i01,i02)%vind_s_dot(i1) + t(3)*u2%element(i01,i02)%vind_s_dot(i1) - t(2)*u3%element(i01,i02)%vind_s_dot(i1) ) * scaleFactor - u_out%element(i01,i02)%vind_s_dot(i1) = u1%element(i01,i02)%vind_s_dot(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 diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 1e0b97173f..290a63ebd6 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -67,7 +67,6 @@ subroutine FVW_Init(AFInfo, InitInp, u, p, x, xd, z, OtherState, y, m, Interval, character(*), parameter :: RoutineName = 'FVW_Init' type(FVW_InputFile) :: InputFileData !< Data stored in the module's input file character(len=1054) :: DirName - integer :: iW ! Initialize variables for this routine ErrStat = ErrID_None @@ -240,6 +239,7 @@ subroutine FVW_InitMiscVars( p, m, ErrStat, ErrMsg ) call AllocAry( m%W(iW)%BN_Cl_Static , p%W(iW)%nSpan+1 , 'Coefficient lift - no UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%W(iW)%BN_Cl_Static = -999999_ReKi; call AllocAry( m%W(iW)%BN_Cd_Static , p%W(iW)%nSpan+1 , 'Coefficient drag - no UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%W(iW)%BN_Cd_Static = -999999_ReKi; call AllocAry( m%W(iW)%BN_Cm_Static , p%W(iW)%nSpan+1 , 'Coefficient moment - no UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%W(iW)%BN_Cm_Static = -999999_ReKi; + call AllocAry( m%W(iW)%BN_Cpmin , p%W(iW)%nSpan+1 , 'Coefficient minimum pressure - no UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%W(iW)%BN_Cpmin = -999999_ReKi; call AllocAry( m%W(iW)%BN_Cl , p%W(iW)%nSpan+1 , 'Coefficient lift - with UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%W(iW)%BN_Cl = -999999_ReKi; call AllocAry( m%W(iW)%BN_Cd , p%W(iW)%nSpan+1 , 'Coefficient drag - with UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%W(iW)%BN_Cd = -999999_ReKi; call AllocAry( m%W(iW)%BN_Cm , p%W(iW)%nSpan+1 , 'Coefficient moment - with UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%W(iW)%BN_Cm = -999999_ReKi; @@ -381,7 +381,7 @@ subroutine FVW_Init_U_Y( p, u, y, m, ErrStat, ErrMsg ) type(FVW_OutputType), intent( out) :: y !< Constraints integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer(IntKi) :: nMax ! Total number of wind points possible + integer(IntKi) :: ErrStat2 ! temporary error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary error message character(*), parameter :: RoutineName = 'FVW_Init_U_Y' @@ -417,7 +417,7 @@ SUBROUTINE FVW_SetParametersFromInputs( InitInp, p, ErrStat, ErrMsg ) character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables character(1024) :: rootDir, baseName ! Simulation root dir and basename - integer(IntKi) :: iW, nRotors, nBldMax + integer(IntKi) :: iW, nBldMax integer(IntKi), allocatable :: nBldPerRot(:) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -662,7 +662,7 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m ! Compute UA inputs at t if (m%UA_Flag) then - call CalculateInputsAndOtherStatesForUA(1, uInterp, p, x, xd, z, OtherState, AFInfo, m, ErrStat2, ErrMsg2); if(Failed()) return + call CalculateInputsAndOtherStatesForUA(1, uInterp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return end if ! --- Integration between t and t+DTfvw @@ -719,7 +719,7 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m !call FVW_CalcConstrStateResidual(t+p%DTfvw, uInterp, p, m%x2, xd, z_guess, OtherState, m, z, AFInfo, ErrStat2, ErrMsg2, 2); if(Failed()) return !! Compute UA inputs at t+DTfvw and integrate UA states between t and t+dtAero !if (m%UA_Flag) then - ! call CalculateInputsAndOtherStatesForUA(2, uInterp, p, m%x2, xd, z, OtherState, AFInfo, m, ErrStat2, ErrMsg2); if(Failed()) return + ! call CalculateInputsAndOtherStatesForUA(2, uInterp, p, m%x2, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return ! call UA_UpdateState_Wrapper(AFInfo, t, n, (/t,t+p%DTfvw/), p, m%x2, xd, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return !end if !! Updating circulation of near wake panel (and position but irrelevant) @@ -758,7 +758,7 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return ! Compute UA inputs at t+DTaero and integrate UA states between t and t+dtAero if (m%UA_Flag) then - call CalculateInputsAndOtherStatesForUA(2, uInterp, p, x, xd, z, OtherState, AFInfo, m, ErrStat2, ErrMsg2); if(Failed()) return + call CalculateInputsAndOtherStatesForUA(2, uInterp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return call UA_UpdateState_Wrapper(AFInfo, t, n, (/t,t+p%DTaero/), p, x, xd, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return ! Compute unsteady Gamma based on UA Cl if (p%DStallOnWake .and. p%CirculationMethod/=idCircPrescribed) then @@ -838,8 +838,8 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt integer(IntKi) :: ErrStat2 ! temporary error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary error message integer(IntKi) :: nFWEff ! Number of farwake panels that are free at current time step - integer(IntKi) :: i,j,k,iW,nP - real(ReKi) :: visc_fact, age ! Viscosity factor for diffusion of reg param + integer(IntKi) :: j,k,iW,nP + real(ReKi) :: visc_fact ! Viscosity factor for diffusion of reg param real(ReKi), dimension(3) :: VmeanFW, VmeanNW ! Mean velocity of the near wake and far wake ErrStat = ErrID_None @@ -1352,14 +1352,13 @@ subroutine FVW_CalcConstrStateResidual( t, u, p, x, xd, z_guess, OtherState, m, end subroutine FVW_CalcConstrStateResidual -subroutine CalcOutputForAD(t, u, p, x, y, m, AFInfo, ErrStat, ErrMsg) +subroutine CalcOutputForAD(t, u, p, x, y, m, ErrStat, ErrMsg) real(DbKi), intent(in ) :: t !< Current simulation time in seconds type(FVW_InputType), intent(in ) :: u !< Inputs at Time t type(FVW_ParameterType), intent(in ) :: p !< Parameters type(FVW_ContinuousStateType), intent(in ) :: x !< Continuous states at t type(FVW_OutputType), intent(inout) :: y !< Outputs computed at t (Input only so that mesh con- type(FVW_MiscVarType), intent(inout) :: m !< Misc/optimization variables - type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None integer(IntKi) :: iW @@ -1400,7 +1399,7 @@ subroutine CalcOutputForAD(t, u, p, x, y, m, AFInfo, ErrStat, ErrMsg) end subroutine CalcOutputForAD !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -subroutine FVW_CalcOutput(t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, ErrMsg) +subroutine FVW_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg) use FVW_VTK, only: set_vtk_coordinate_transform use FVW_VortexTools, only: interpextrap_cp2node real(DbKi), intent(in ) :: t !< Current simulation time in seconds @@ -1410,7 +1409,6 @@ subroutine FVW_CalcOutput(t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, type(FVW_DiscreteStateType), intent(in ) :: xd !< Discrete states at t type(FVW_ConstraintStateType), intent(in ) :: z !< Constraint states at t type(FVW_OtherStateType), intent(in ) :: OtherState !< Other states at t - type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data type(FVW_OutputType), intent(inout) :: y !< Outputs computed at t (Input only so that mesh con- !! nectivity information does not have to be recalculated) type(FVW_MiscVarType), intent(inout) :: m !< Misc/optimization variables @@ -1421,7 +1419,7 @@ subroutine FVW_CalcOutput(t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CalcOutput' logical :: bOverCycling - real(ReKi) :: fact + ErrStat = ErrID_None ErrMsg = "" if (DEV_VERSION) then @@ -1432,7 +1430,7 @@ subroutine FVW_CalcOutput(t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, bOverCycling = p%DTfvw > p%DTaero ! Compute induced velocity at AD nodes - call CalcOutputForAD(t,u,p,x,y,m,AFInfo, ErrStat2, ErrMsg2) + call CalcOutputForAD(t,u,p,x,y,m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Export to VTK @@ -1599,7 +1597,7 @@ end subroutine UA_Init_Wrapper !> Compute necessary inputs for UA at a given time step, stored in m%u_UA !! Inputs are AoA, U, Re, !! See equivalent version in BEMT, and SetInputs_for_UA in BEMT -subroutine CalculateInputsAndOtherStatesForUA(InputIndex, u, p, x, xd, z, OtherState, AFInfo, m, ErrStat, ErrMsg) +subroutine CalculateInputsAndOtherStatesForUA(InputIndex, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: InputIndex ! InputIndex= 1 or 2, depending on time step we are calculating inputs for type(FVW_InputType), intent(in ) :: u ! Input type(FVW_ParameterType), intent(in ) :: p ! Parameters @@ -1608,7 +1606,6 @@ subroutine CalculateInputsAndOtherStatesForUA(InputIndex, u, p, x, xd, z, OtherS type(FVW_ConstraintStateType), intent(in ) :: z ! Constraint states at given time step type(FVW_OtherStateType), intent(inout) :: OtherState ! Other states at given time step type(FVW_MiscVarType), target, intent(inout) :: m ! Misc/optimization variables - type(AFI_ParameterType), intent(in ) :: AFInfo(:) ! The airfoil parameter data integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local @@ -1717,7 +1714,6 @@ subroutine UA_SetGammaDyn(t, u, p, x, xd, OtherState, m, AFInfo, z, ErrStat, Err type(FVW_ConstraintStateType), intent(inout) :: z !< Constraint states integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - real(ReKi) :: Cl_dyn, Cl_dyn_prev, Cl_dyn_avg real(ReKi) :: Gamma_dyn, Gamma_dyn_prev, Gamma_dyn_avg type(UA_InputType), pointer :: u_UA ! Alias to shorten notations integer(IntKi), parameter :: InputIndex=2 ! we will always use values at t+dt in this routine diff --git a/modules/aerodyn/src/FVW_IO.f90 b/modules/aerodyn/src/FVW_IO.f90 index c0a173ecef..041aa73221 100644 --- a/modules/aerodyn/src/FVW_IO.f90 +++ b/modules/aerodyn/src/FVW_IO.f90 @@ -18,7 +18,7 @@ SUBROUTINE FVW_ReadInputFile( FileName, p, m, Inp, ErrStat, ErrMsg ) character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables character(1024) :: PriPath ! the path to the primary input file - character(1024) :: sDummy, sLine, Key, Val ! string to temporarially hold value of read line + character(1024) :: sDummy, sLine ! string to temporarially hold value of read line integer(IntKi) :: UnIn, i integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 diff --git a/modules/aerodyn/src/FVW_Registry.txt b/modules/aerodyn/src/FVW_Registry.txt index 4b820161e3..6083c2609d 100644 --- a/modules/aerodyn/src/FVW_Registry.txt +++ b/modules/aerodyn/src/FVW_Registry.txt @@ -165,6 +165,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi BN_Cl_Static : - - "Coefficient lift, excluding unsteady aero effects" - typedef ^ ^ ReKi BN_Cd_Static : - - "Coefficient drag. excluding unsteady aero effects" - typedef ^ ^ ReKi BN_Cm_Static : - - "Coefficient moment, excluding unsteady aero effects" - +typedef ^ ^ ReKi BN_Cpmin : - - "Coefficient minimum pressure, excluding unsteady aero effects" - typedef ^ ^ ReKi BN_Cl : - - "Coefficient lift, including unsteady aero effects" - typedef ^ ^ ReKi BN_Cd : - - "Coefficient drag, including unsteady aero effects" - typedef ^ ^ ReKi BN_Cm : - - "Coefficient moment, including unsteady aero effects" - diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index 676f5ee445..9d143f042e 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -276,14 +276,14 @@ subroutine Map_NW_FW(p, m, z, x, ErrStat, ErrMsg) type(FVW_ContinuousStateType), intent(inout) :: x !< Continuous states integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer(IntKi) :: iW, iRoot, iTip, iMax + integer(IntKi) :: iW, iRoot, iTip real(ReKi), dimension(p%nWings) :: FWGamma real(ReKi), dimension(:),allocatable :: Gamma_t real(ReKi), dimension(:),allocatable :: sCoord ! real(ReKi), dimension(p%W(iW)%nSpan+1) :: Gamma_t ! real(ReKi), dimension(p%W(iW)%nSpan) :: sCoord real(ReKi) :: FWEpsTip, FWEpsRoot - real(ReKi) :: ltip, rTip, Gamma_max + integer(IntKi), parameter :: iAgeFW=1 !< we update the first FW panel ErrStat = ErrID_None ErrMsg = "" diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 72df451fa7..467509e196 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -194,6 +194,7 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BN_Cl_Static !< Coefficient lift, excluding unsteady aero effects [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BN_Cd_Static !< Coefficient drag. excluding unsteady aero effects [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BN_Cm_Static !< Coefficient moment, excluding unsteady aero effects [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BN_Cpmin !< Coefficient minimum pressure, excluding unsteady aero effects [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BN_Cl !< Coefficient lift, including unsteady aero effects [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BN_Cd !< Coefficient drag, including unsteady aero effects [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BN_Cm !< Coefficient moment, including unsteady aero effects [-] @@ -406,15 +407,27 @@ SUBROUTINE FVW_CopyGridOutType( SrcGridOutTypeData, DstGridOutTypeData, CtrlCode DstGridOutTypeData%tLastOutput = SrcGridOutTypeData%tLastOutput END SUBROUTINE FVW_CopyGridOutType - SUBROUTINE FVW_DestroyGridOutType( GridOutTypeData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyGridOutType( GridOutTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(GridOutType), INTENT(INOUT) :: GridOutTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyGridOutType' + LOGICAL,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 @@ -807,15 +820,27 @@ SUBROUTINE FVW_CopyT_Sgmt( SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrM DstT_SgmtData%nActP = SrcT_SgmtData%nActP END SUBROUTINE FVW_CopyT_Sgmt - SUBROUTINE FVW_DestroyT_Sgmt( T_SgmtData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyT_Sgmt' + LOGICAL,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 @@ -1205,15 +1230,27 @@ SUBROUTINE FVW_CopyWng_ParameterType( SrcWng_ParameterTypeData, DstWng_Parameter ENDIF END SUBROUTINE FVW_CopyWng_ParameterType - SUBROUTINE FVW_DestroyWng_ParameterType( Wng_ParameterTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ParameterType' + LOGICAL,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 @@ -1666,18 +1703,31 @@ SUBROUTINE FVW_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%Induction = SrcParamData%Induction END SUBROUTINE FVW_CopyParam - SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FVW_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyParam' + LOGICAL,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), ErrStat, ErrMsg ) + CALL FVW_Destroywng_parametertype( ParamData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%W) ENDIF @@ -2282,15 +2332,27 @@ SUBROUTINE FVW_CopyWng_ContinuousStateType( SrcWng_ContinuousStateTypeData, DstW ENDIF END SUBROUTINE FVW_CopyWng_ContinuousStateType - SUBROUTINE FVW_DestroyWng_ContinuousStateType( Wng_ContinuousStateTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ContinuousStateType' + LOGICAL,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 @@ -2783,24 +2845,38 @@ SUBROUTINE FVW_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrS ENDIF END SUBROUTINE FVW_CopyContState - SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyContState' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL UA_DestroyContState( ContStateData%UA(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%UA) ENDIF @@ -3172,15 +3248,27 @@ SUBROUTINE FVW_CopyWng_OutputType( SrcWng_OutputTypeData, DstWng_OutputTypeData, ENDIF END SUBROUTINE FVW_CopyWng_OutputType - SUBROUTINE FVW_DestroyWng_OutputType( Wng_OutputTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_OutputType' + LOGICAL,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 @@ -3361,18 +3449,31 @@ SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM ENDIF END SUBROUTINE FVW_CopyOutput - SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FVW_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOutput' + LOGICAL,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), ErrStat, ErrMsg ) + CALL FVW_Destroywng_outputtype( OutputData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%W) ENDIF @@ -4070,6 +4171,18 @@ SUBROUTINE FVW_CopyWng_MiscVarType( SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDa 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) @@ -4132,15 +4245,27 @@ SUBROUTINE FVW_CopyWng_MiscVarType( SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDa ENDIF END SUBROUTINE FVW_CopyWng_MiscVarType - SUBROUTINE FVW_DestroyWng_MiscVarType( Wng_MiscVarTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_MiscVarType' + LOGICAL,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 @@ -4207,14 +4332,18 @@ SUBROUTINE FVW_DestroyWng_MiscVarType( Wng_MiscVarTypeData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL UA_DestroyOutput( Wng_MiscVarTypeData%y_UA, ErrStat, ErrMsg ) - CALL UA_DestroyParam( Wng_MiscVarTypeData%p_UA, ErrStat, ErrMsg ) + 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 @@ -4248,6 +4377,9 @@ SUBROUTINE FVW_DestroyWng_MiscVarType( Wng_MiscVarTypeData, ErrStat, ErrMsg ) 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 @@ -4539,6 +4671,11 @@ SUBROUTINE FVW_PackWng_MiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 @@ -5320,6 +5457,21 @@ SUBROUTINE FVW_PackWng_MiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 @@ -6302,6 +6454,24 @@ SUBROUTINE FVW_UnPackWng_MiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt 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 @@ -6509,28 +6679,45 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_CopyMisc - SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FVW_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyMisc' + LOGICAL,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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL FVW_DestroyContState( MiscData%x1, ErrStat, ErrMsg ) - CALL FVW_DestroyContState( MiscData%x2, ErrStat, ErrMsg ) - CALL FVW_Destroyt_sgmt( MiscData%Sgmt, ErrStat, ErrMsg ) + 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) IF (ALLOCATED(MiscData%CPs)) THEN DEALLOCATE(MiscData%CPs) ENDIF @@ -6539,7 +6726,8 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(MiscData%GridOutputs)) THEN DO i1 = LBOUND(MiscData%GridOutputs,1), UBOUND(MiscData%GridOutputs,1) - CALL FVW_Destroygridouttype( MiscData%GridOutputs(i1), ErrStat, ErrMsg ) + CALL FVW_Destroygridouttype( MiscData%GridOutputs(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%GridOutputs) ENDIF @@ -7439,15 +7627,27 @@ SUBROUTINE FVW_CopyRot_InputType( SrcRot_InputTypeData, DstRot_InputTypeData, Ct DstRot_InputTypeData%HubPosition = SrcRot_InputTypeData%HubPosition END SUBROUTINE FVW_CopyRot_InputType - SUBROUTINE FVW_DestroyRot_InputType( Rot_InputTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyRot_InputType' + LOGICAL,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 ) @@ -7616,15 +7816,27 @@ SUBROUTINE FVW_CopyWng_InputType( SrcWng_InputTypeData, DstWng_InputTypeData, Ct ENDIF END SUBROUTINE FVW_CopyWng_InputType - SUBROUTINE FVW_DestroyWng_InputType( Wng_InputTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_InputType' + LOGICAL,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 @@ -7893,30 +8105,45 @@ SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE FVW_CopyInput - SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FVW_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInput' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL MeshDestroy( InputData%WingsMesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputData%WingsMesh) ENDIF @@ -8462,18 +8689,31 @@ SUBROUTINE FVW_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS ENDIF END SUBROUTINE FVW_CopyDiscState - SUBROUTINE FVW_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FVW_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyDiscState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL UA_DestroyDiscState( DiscStateData%UA(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DiscStateData%UA) ENDIF @@ -8727,15 +8967,27 @@ SUBROUTINE FVW_CopyWng_ConstraintStateType( SrcWng_ConstraintStateTypeData, DstW ENDIF END SUBROUTINE FVW_CopyWng_ConstraintStateType - SUBROUTINE FVW_DestroyWng_ConstraintStateType( Wng_ConstraintStateTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ConstraintStateType' + LOGICAL,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 @@ -8906,18 +9158,31 @@ SUBROUTINE FVW_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode DstConstrStateData%residual = SrcConstrStateData%residual END SUBROUTINE FVW_CopyConstrState - SUBROUTINE FVW_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FVW_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyConstrState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL FVW_Destroywng_constraintstatetype( ConstrStateData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ConstrStateData%W) ENDIF @@ -9176,18 +9441,31 @@ SUBROUTINE FVW_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E ENDIF END SUBROUTINE FVW_CopyOtherState - SUBROUTINE FVW_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FVW_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOtherState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL UA_DestroyOtherState( OtherStateData%UA(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%UA) ENDIF @@ -9471,15 +9749,27 @@ SUBROUTINE FVW_CopyWng_InitInputType( SrcWng_InitInputTypeData, DstWng_InitInput DstWng_InitInputTypeData%UAOff_outerNode = SrcWng_InitInputTypeData%UAOff_outerNode END SUBROUTINE FVW_CopyWng_InitInputType - SUBROUTINE FVW_DestroyWng_InitInputType( Wng_InitInputTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_InitInputType' + LOGICAL,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 @@ -9783,24 +10073,38 @@ SUBROUTINE FVW_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%SumPrint = SrcInitInputData%SumPrint END SUBROUTINE FVW_CopyInitInput - SUBROUTINE FVW_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FVW_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInitInput' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL MeshDestroy( InitInputData%WingsMesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%WingsMesh) ENDIF @@ -10245,15 +10549,27 @@ SUBROUTINE FVW_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%VTKCoord = SrcInputFileData%VTKCoord END SUBROUTINE FVW_CopyInputFile - SUBROUTINE FVW_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FVW_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInputFile' + LOGICAL,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 ) @@ -10524,15 +10840,27 @@ SUBROUTINE FVW_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%Null = SrcInitOutputData%Null END SUBROUTINE FVW_CopyInitOutput - SUBROUTINE FVW_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE FVW_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FVW_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInitOutput' + LOGICAL,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 ) diff --git a/modules/aerodyn/src/FVW_VortexTools.f90 b/modules/aerodyn/src/FVW_VortexTools.f90 index d07345127d..cdb3ecf420 100644 --- a/modules/aerodyn/src/FVW_VortexTools.f90 +++ b/modules/aerodyn/src/FVW_VortexTools.f90 @@ -250,7 +250,7 @@ subroutine LatticeToPoints2D(LatticePoints, Points, iHeadP) real(ReKi), dimension(:,:), intent(inout) :: Points !< integer(IntKi), intent(inout) :: iHeadP !< Index indicating where to start in Points ! Local - integer(IntKi) :: iSpan, iDepth + integer(IntKi) :: iSpan do iSpan = 1, size(LatticePoints,2) Points(1:3,iHeadP) = LatticePoints(1:3, iSpan) iHeadP=iHeadP+1 @@ -931,7 +931,7 @@ subroutine grow_tree_segment_substep(node, Seg) real(ReKi) :: wTot ! Total vorticity strength real(ReKi) :: SegLen ! Length of vortex segment real(ReKi) :: halfSize ! TODO remove me - real(ReKi),dimension(3) :: locCenter, DeltaP,SegCenter,DP, SegDir, SegGammaVec + real(ReKi),dimension(3) :: locCenter, SegCenter,DP, SegDir, SegGammaVec real(ReKi),dimension(3) :: P1,P2 !< Segment extremities real(ReKi),dimension(3) :: nodeGeomCenter !< Geometric center from division of the domain in powers of 2 real(ReKi),dimension(3) :: nodeBaryCenter !< Vorticity weighted center diff --git a/modules/aerodyn/src/UnsteadyAero.f90 b/modules/aerodyn/src/UnsteadyAero.f90 index 1c8421c14f..abd633b8f8 100644 --- a/modules/aerodyn/src/UnsteadyAero.f90 +++ b/modules/aerodyn/src/UnsteadyAero.f90 @@ -18,6 +18,23 @@ ! limitations under the License. ! !********************************************************************************************************************************** +! References: +! +! [40] E. Branlard, B. Jonkman, G.R. Pirrung, K. Dixon, J. Jonkman (2022) +! Dynamic inflow and unsteady aerodynamics models for modal and stability analyses in OpenFAST, +! Journal of Physics: Conference Series, doi:10.1088/1742-6596/2265/3/032044 +! +! [41] E. Branlard, J. Jonkman, B.Jonkman (2020) +! Development plan for the aerodynamic linearization in OpenFAST +! Unpublished +! +! [70] User Documentation / AeroDyn / Unsteady Aerodynamics / Boing-Vertol model +! https://openfast.readthedocs.io/ +! +! [other] R. Damiani and G. Hayman (2017) +! The Unsteady Aerodynamics Module for FAST 8 +! NOTE: equations for this reference are labeled as x.y [n] where n is the number of the equation when several equations are given. + module UnsteadyAero ! This module uses equations defined in the document "The Unsteady Aerodynamics Module for FAST 8" by Rick Damiani and Greg Hayman, 28-Feb-2017 @@ -728,8 +745,10 @@ subroutine UA_SetParameters( dt, InitInp, p, AFInfo, AFIndx, ErrStat, ErrMsg ) p%Flookup = InitInp%Flookup p%ShedEffect = InitInp%ShedEffect - if (p%UAMod==UA_HGM) then + 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) + 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 else p%lin_nx = 0 end if @@ -1358,7 +1377,7 @@ subroutine UA_ValidateInput(InitInp, ErrStat, ErrMsg) 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)& + "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. InitInp%FLookUp ) call SetErrStat( ErrID_Fatal, 'FLookUp must be TRUE for this version.', ErrStat, ErrMsg, RoutineName ) @@ -1648,7 +1667,7 @@ end function Failed end subroutine UA_UpdateDiscOtherState_BV !============================================================================== -!> Calculate angle of attacks using Boeing-Vertol model +!> Calculate angle of attacks using Boeing-Vertol model, see [70] !! Drag effective angle of attack needs extra computation subroutine BV_getAlphas(i, j, u, p, xd, BL_p, tc, alpha_34, alphaE_L, alphaLag_D, adotnorm) integer, intent(in ) :: i !< node index within a blade @@ -1707,7 +1726,7 @@ subroutine BV_getAlphas(i, j, u, p, xd, BL_p, tc, alpha_34, alphaE_L, alphaLag_D 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 @@ -1750,7 +1769,7 @@ real(ReKi) function BV_TransA(BL_p) BV_TransA = .5_ReKi*dalphaMax ! transition region for fairing lagged AOA in pure lag model end function BV_TransA !============================================================================== -!> Calculate deltas to negative and postivive stall angle +!> Calculate deltas to negative and postivive stall angle, see [70] subroutine BV_delNP(adotnorm, alpha, alphaLag_D, BL_p, activeD, delN, delP) real(ReKi), intent(in) :: adotnorm !< alphadot * Tu real(ReKi), intent(in) :: alpha !< alpha (3/4) @@ -1782,7 +1801,7 @@ subroutine BV_delNP(adotnorm, alpha, alphaLag_D, BL_p, activeD, delN, delP) end if end subroutine BV_delNP !============================================================================== -!> Calculate effective angle of attack for drag coefficient, based on lagged angle of attack +!> Calculate effective angle of attack for drag coefficient, based on lagged angle of attack, see [70] real(ReKi) function BV_alphaE_D(adotnorm, alpha, alphaLag_D, BL_p, activeD) real(ReKi), intent(in) :: adotnorm !< alphadot * Tu real(ReKi), intent(in) :: alpha !< alpha (3/4) @@ -1811,7 +1830,7 @@ real(ReKi) function BV_alphaE_D(adotnorm, alpha, alphaLag_D, BL_p, activeD) end if end function BV_alphaE_D !============================================================================== -!> Activate dynamic stall for lift or drag +!> Activate dynamic stall for lift or drag, see [70] subroutine BV_UpdateActiveStates(adotnorm, alpha, alphaLag_D, alphaE_L, BL_p, activeL, activeD) real(ReKi), intent(in) :: adotnorm !< alphadot * Tu real(ReKi), intent(in) :: alpha !< alpha (3/4) @@ -2414,7 +2433,7 @@ SUBROUTINE HGM_Steady( i, j, u, p, x, AFInfo, ErrStat, ErrMsg ) x%x(3) = AFI_interp%Cl ! Not used elseif (p%UAMod==UA_HGM) then - x%x(3) = BL_p%c_lalpha * (alphaE-BL_p%alpha0) + x%x(3) = BL_p%c_lalpha * (alphaE-BL_p%alpha0) ! Clp ! calculate x%x(4) = fs_aF = f_st(alphaF): !alphaF = x%x(3)/BL_p%c_lalpha + BL_p%alpha0 ! p. 13 @@ -2513,7 +2532,7 @@ subroutine UA_CalcContStateDeriv( i, j, t, u_in, p, x, OtherState, AFInfo, m, dx ! 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 ! p. 13 + alphaF = x%x(3)/BL_p%c_lalpha + BL_p%alpha0 ! Eq. 15 [40] else if (p%UAMod == UA_OYE) then alphaF = alpha_34 @@ -2550,8 +2569,8 @@ subroutine UA_CalcContStateDeriv( i, j, t, u_in, p, x, OtherState, AFInfo, m, dx 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 - 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 + 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] else dxdt%x(1) = 0.0_ReKi dxdt%x(2) = 0.0_ReKi @@ -2560,8 +2579,8 @@ subroutine UA_CalcContStateDeriv( i, j, t, u_in, p, x, OtherState, AFInfo, m, dx 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 - dxdt%x(4) = -1.0_R8Ki / BL_p%T_f0 * x4 + 1.0_ReKi / BL_p%T_f0 * AFI_AlphaF%f_st + 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] dxdt%x(5) = 0.0_R8Ki elseif (p%UAMod == UA_OYE) then @@ -3008,6 +3027,7 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, real(ReKi) :: cn_circ, tau_vl, tV_ratio real(ReKi) :: delta_c_df_primeprime real(ReKi), parameter :: delta_c_mf_primeprime = 0.0_ReKi + real(ReKi) :: cl_circ, cd_tors TYPE(UA_ElementContinuousStateType) :: x_in ! Continuous states at t ! for BV real(ReKi) :: alphaE_L, alphaE_D ! effective angle of attack for lift and drag @@ -3138,18 +3158,20 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, call AddOrSub2Pi(BL_p%alpha0, alphaE) cl_fa = (alphaE - BL_p%alpha0) * BL_p%c_lalpha - delta_c_df_primeprime = 0.5_ReKi * (sqrt(fs_aE) - sqrt(x4)) - 0.25_ReKi * (fs_aE - x4) ! Eq. 81 + 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? - y%Cl = x4 * cl_fa + (1.0_ReKi - x4) * cl_fs + pi * Tu * u%omega ! Eq. 78 + 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] call AddOrSub2Pi(u%alpha, alphaE) - y%Cd = AFI_interp%Cd + (u%alpha - alphaE) * y%Cl + (AFI_interp%Cd - BL_p%Cd0) * delta_c_df_primeprime ! Eq. 79 + 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] 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. 80 + y%Cm = AFI_interp%Cm + y%Cl * delta_c_mf_primeprime - piBy2 * Tu * u%omega ! Eq. 18 [40] end if y%Cn = y%Cl*cos(u%alpha) + y%Cd*sin(u%alpha) @@ -3170,10 +3192,10 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, 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. 81 + 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 + y%Cd = AFI_interp%Cd + (u%alpha - alphaE) * y%Cn + (AFI_interp%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 @@ -3453,7 +3475,7 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, contains !> Calc Outputs for Boieng-Vertol dynamic stall - !! See BV_DynStall.f95 of CACTUS, notations kept more or less consistent + !! See BV_DynStall.f95 of CACTUS, and [70], notations kept more or less consistent subroutine BV_CalcOutput() real(ReKi) :: alpha_50 real(ReKi) :: Cm25_stat diff --git a/modules/aerodyn/src/UnsteadyAero_Driver.f90 b/modules/aerodyn/src/UnsteadyAero_Driver.f90 index cd1591a122..30dc3c0480 100644 --- a/modules/aerodyn/src/UnsteadyAero_Driver.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Driver.f90 @@ -289,18 +289,47 @@ subroutine setUAinputs(n,u,t,dt,dvrInitInp,timeArr,AOAarr,Uarr,OmegaArr) real(ReKi), intent(in) :: OmegaArr(:) 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 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 - u%alpha = (dvrInitInp%Amplitude * sin(phase) + dvrInitInp%Mean)*D2R ! This needs to be in radians - ! u%omega = dvrInitInp%Amplitude * cos(phase) * dvrInitInp%Frequency * pi**2 / 90.0 ! This needs to be in radians derivative: d_alpha /d_t + 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%U = dvrInitInp%InflowVel ! m/s + + 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 indx = min(n,size(timeArr)) indx = max(1, indx) ! use constant data at initialization @@ -315,9 +344,9 @@ subroutine setUAinputs(n,u,t,dt,dvrInitInp,timeArr,AOAarr,Uarr,OmegaArr) 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 end if - u%v_ac(1) = sin(u%alpha)*u%U - u%v_ac(2) = cos(u%alpha)*u%U end subroutine setUAinputs !---------------------------------------------------------------------------------------------------- diff --git a/modules/aerodyn/src/UnsteadyAero_Registry.txt b/modules/aerodyn/src/UnsteadyAero_Registry.txt index 733a4b46b3..25bdee4239 100644 --- a/modules/aerodyn/src/UnsteadyAero_Registry.txt +++ b/modules/aerodyn/src/UnsteadyAero_Registry.txt @@ -114,8 +114,8 @@ 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)" rad/s -typedef ^ DiscreteStateType ReKi alpha_dot_minus1 {:}{:} - - "Rate of change of angle of attack (filtered)" rad/s +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 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" - diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 48c47a9ffd..035021149b 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -133,8 +133,8 @@ MODULE UnsteadyAero_Types TYPE, PUBLIC :: UA_DiscreteStateType 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) [rad/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: alpha_dot_minus1 !< Rate of change of angle of attack (filtered) [rad/s] + 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 :: 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 [-] @@ -309,15 +309,27 @@ SUBROUTINE UA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt ENDIF END SUBROUTINE UA_CopyInitInput - SUBROUTINE UA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInitInput' + LOGICAL,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 @@ -640,16 +652,29 @@ SUBROUTINE UA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er ENDIF END SUBROUTINE UA_CopyInitOutput - SUBROUTINE UA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInitOutput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Version, ErrStat, 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 @@ -988,15 +1013,27 @@ SUBROUTINE UA_CopyKelvinChainType( SrcKelvinChainTypeData, DstKelvinChainTypeDat DstKelvinChainTypeData%ds = SrcKelvinChainTypeData%ds END SUBROUTINE UA_CopyKelvinChainType - SUBROUTINE UA_DestroyKelvinChainType( KelvinChainTypeData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyKelvinChainType( KelvinChainTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_KelvinChainType), INTENT(INOUT) :: KelvinChainTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyKelvinChainType' + LOGICAL,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 ) @@ -1364,15 +1401,27 @@ SUBROUTINE UA_CopyElementContinuousStateType( SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData%x = SrcElementContinuousStateTypeData%x END SUBROUTINE UA_CopyElementContinuousStateType - SUBROUTINE UA_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_ElementContinuousStateType), INTENT(INOUT) :: ElementContinuousStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyElementContinuousStateType' + LOGICAL,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 ) @@ -1517,19 +1566,32 @@ SUBROUTINE UA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE UA_CopyContState - SUBROUTINE UA_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyContState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL UA_Destroyelementcontinuousstatetype( ContStateData%element(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO DEALLOCATE(ContStateData%element) @@ -2257,15 +2319,27 @@ SUBROUTINE UA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE UA_CopyDiscState - SUBROUTINE UA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyDiscState' + LOGICAL,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 @@ -4113,15 +4187,27 @@ SUBROUTINE UA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstraintState = SrcConstrStateData%DummyConstraintState END SUBROUTINE UA_CopyConstrState - SUBROUTINE UA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyConstrState' + LOGICAL,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 ) @@ -4426,15 +4512,27 @@ SUBROUTINE UA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er ENDIF END SUBROUTINE UA_CopyOtherState - SUBROUTINE UA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyOtherState' + LOGICAL,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 @@ -4454,7 +4552,8 @@ SUBROUTINE UA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) DEALLOCATE(OtherStateData%n) ENDIF DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL UA_DestroyContState( OtherStateData%xdot(i1), ErrStat, ErrMsg ) + 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) @@ -5396,15 +5495,27 @@ SUBROUTINE UA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_CopyMisc - SUBROUTINE UA_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyMisc' + LOGICAL,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 @@ -5882,15 +5993,27 @@ SUBROUTINE UA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_CopyParam - SUBROUTINE UA_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyParam' + LOGICAL,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 @@ -6194,15 +6317,27 @@ SUBROUTINE UA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) DstInputData%omega = SrcInputData%omega END SUBROUTINE UA_CopyInput - SUBROUTINE UA_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInput' + LOGICAL,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 ) @@ -6368,15 +6503,27 @@ SUBROUTINE UA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE UA_CopyOutput - SUBROUTINE UA_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE UA_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(UA_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyOutput' + LOGICAL,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 diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 2424723133..51041bf082 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -493,15 +493,27 @@ SUBROUTINE AD14_CopyMarker( SrcMarkerData, DstMarkerData, CtrlCode, ErrStat, Err DstMarkerData%RotationVel = SrcMarkerData%RotationVel END SUBROUTINE AD14_CopyMarker - SUBROUTINE AD14_DestroyMarker( MarkerData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyMarker( MarkerData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Marker), INTENT(INOUT) :: MarkerData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyMarker' + LOGICAL,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 ) @@ -704,28 +716,48 @@ SUBROUTINE AD14_CopyAeroConfig( SrcAeroConfigData, DstAeroConfigData, CtrlCode, DstAeroConfigData%BladeLength = SrcAeroConfigData%BladeLength END SUBROUTINE AD14_CopyAeroConfig - SUBROUTINE AD14_DestroyAeroConfig( AeroConfigData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyAeroConfig( AeroConfigData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AeroConfig), INTENT(INOUT) :: AeroConfigData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAeroConfig' + LOGICAL,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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL AD14_Destroymarker( AeroConfigData%RotorFurl, ErrStat, ErrMsg ) - CALL AD14_Destroymarker( AeroConfigData%Nacelle, ErrStat, ErrMsg ) - CALL AD14_Destroymarker( AeroConfigData%TailFin, ErrStat, ErrMsg ) - CALL AD14_Destroymarker( AeroConfigData%Tower, ErrStat, ErrMsg ) - CALL AD14_Destroymarker( AeroConfigData%SubStructure, ErrStat, ErrMsg ) - CALL AD14_Destroymarker( AeroConfigData%Foundation, ErrStat, ErrMsg ) + 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 ) @@ -1625,15 +1657,27 @@ SUBROUTINE AD14_CopyAirFoil( SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, DstAirFoilData%MulTabLoc = SrcAirFoilData%MulTabLoc END SUBROUTINE AD14_CopyAirFoil - SUBROUTINE AD14_DestroyAirFoil( AirFoilData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyAirFoil( AirFoilData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AirFoil), INTENT(INOUT) :: AirFoilData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAirFoil' + LOGICAL,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 @@ -2058,15 +2102,27 @@ SUBROUTINE AD14_CopyAirFoilParms( SrcAirFoilParmsData, DstAirFoilParmsData, Ctrl ENDIF END SUBROUTINE AD14_CopyAirFoilParms - SUBROUTINE AD14_DestroyAirFoilParms( AirFoilParmsData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyAirFoilParms( AirFoilParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AirFoilParms), INTENT(INOUT) :: AirFoilParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAirFoilParms' + LOGICAL,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 @@ -3161,15 +3217,27 @@ SUBROUTINE AD14_CopyBeddoes( SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, DstBeddoesData%VOR = SrcBeddoesData%VOR END SUBROUTINE AD14_CopyBeddoes - SUBROUTINE AD14_DestroyBeddoes( BeddoesData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyBeddoes( BeddoesData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Beddoes), INTENT(INOUT) :: BeddoesData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBeddoes' + LOGICAL,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 @@ -6025,15 +6093,27 @@ SUBROUTINE AD14_CopyBeddoesParms( SrcBeddoesParmsData, DstBeddoesParmsData, Ctrl DstBeddoesParmsData%TVL = SrcBeddoesParmsData%TVL END SUBROUTINE AD14_CopyBeddoesParms - SUBROUTINE AD14_DestroyBeddoesParms( BeddoesParmsData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyBeddoesParms( BeddoesParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BeddoesParms), INTENT(INOUT) :: BeddoesParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBeddoesParms' + LOGICAL,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 ) @@ -6196,15 +6276,27 @@ SUBROUTINE AD14_CopyBladeParms( SrcBladeParmsData, DstBladeParmsData, CtrlCode, DstBladeParmsData%BladeLength = SrcBladeParmsData%BladeLength END SUBROUTINE AD14_CopyBladeParms - SUBROUTINE AD14_DestroyBladeParms( BladeParmsData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyBladeParms( BladeParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BladeParms), INTENT(INOUT) :: BladeParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBladeParms' + LOGICAL,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 @@ -6467,15 +6559,27 @@ SUBROUTINE AD14_CopyDynInflow( SrcDynInflowData, DstDynInflowData, CtrlCode, Err DstDynInflowData%GAMMA = SrcDynInflowData%GAMMA END SUBROUTINE AD14_CopyDynInflow - SUBROUTINE AD14_DestroyDynInflow( DynInflowData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyDynInflow( DynInflowData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DynInflow), INTENT(INOUT) :: DynInflowData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDynInflow' + LOGICAL,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 @@ -6966,15 +7070,27 @@ SUBROUTINE AD14_CopyDynInflowParms( SrcDynInflowParmsData, DstDynInflowParmsData DstDynInflowParmsData%xMinv = SrcDynInflowParmsData%xMinv END SUBROUTINE AD14_CopyDynInflowParms - SUBROUTINE AD14_DestroyDynInflowParms( DynInflowParmsData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyDynInflowParms( DynInflowParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DynInflowParms), INTENT(INOUT) :: DynInflowParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDynInflowParms' + LOGICAL,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 ) @@ -7202,15 +7318,27 @@ SUBROUTINE AD14_CopyElement( SrcElementData, DstElementData, CtrlCode, ErrStat, ENDIF END SUBROUTINE AD14_CopyElement - SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Element), INTENT(INOUT) :: ElementData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElement' + LOGICAL,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 @@ -7730,15 +7858,27 @@ SUBROUTINE AD14_CopyElementParms( SrcElementParmsData, DstElementParmsData, Ctrl ENDIF END SUBROUTINE AD14_CopyElementParms - SUBROUTINE AD14_DestroyElementParms( ElementParmsData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyElementParms( ElementParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ElementParms), INTENT(INOUT) :: ElementParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElementParms' + LOGICAL,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 @@ -8296,15 +8436,27 @@ SUBROUTINE AD14_CopyElOutParms( SrcElOutParmsData, DstElOutParmsData, CtrlCode, DstElOutParmsData%NumElOut = SrcElOutParmsData%NumElOut END SUBROUTINE AD14_CopyElOutParms - SUBROUTINE AD14_DestroyElOutParms( ElOutParmsData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyElOutParms( ElOutParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ElOutParms), INTENT(INOUT) :: ElOutParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElOutParms' + LOGICAL,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 @@ -9375,15 +9527,27 @@ SUBROUTINE AD14_CopyInducedVel( SrcInducedVelData, DstInducedVelData, CtrlCode, DstInducedVelData%SumInFl = SrcInducedVelData%SumInFl END SUBROUTINE AD14_CopyInducedVel - SUBROUTINE AD14_DestroyInducedVel( InducedVelData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyInducedVel( InducedVelData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InducedVel), INTENT(INOUT) :: InducedVelData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInducedVel' + LOGICAL,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 ) @@ -9506,15 +9670,27 @@ SUBROUTINE AD14_CopyInducedVelParms( SrcInducedVelParmsData, DstInducedVelParmsD DstInducedVelParmsData%HLoss = SrcInducedVelParmsData%HLoss END SUBROUTINE AD14_CopyInducedVelParms - SUBROUTINE AD14_DestroyInducedVelParms( InducedVelParmsData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyInducedVelParms( InducedVelParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InducedVelParms), INTENT(INOUT) :: InducedVelParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInducedVelParms' + LOGICAL,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 ) @@ -9669,15 +9845,27 @@ SUBROUTINE AD14_CopyRotor( SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg DstRotorData%YawVEL = SrcRotorData%YawVEL END SUBROUTINE AD14_CopyRotor - SUBROUTINE AD14_DestroyRotor( RotorData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyRotor( RotorData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Rotor), INTENT(INOUT) :: RotorData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyRotor' + LOGICAL,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 ) @@ -9834,15 +10022,27 @@ SUBROUTINE AD14_CopyRotorParms( SrcRotorParmsData, DstRotorParmsData, CtrlCode, DstRotorParmsData%HH = SrcRotorParmsData%HH END SUBROUTINE AD14_CopyRotorParms - SUBROUTINE AD14_DestroyRotorParms( RotorParmsData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyRotorParms( RotorParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(RotorParms), INTENT(INOUT) :: RotorParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyRotorParms' + LOGICAL,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 ) @@ -10050,15 +10250,27 @@ SUBROUTINE AD14_CopyTwrPropsParms( SrcTwrPropsParmsData, DstTwrPropsParmsData, C ENDIF END SUBROUTINE AD14_CopyTwrPropsParms - SUBROUTINE AD14_DestroyTwrPropsParms( TwrPropsParmsData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyTwrPropsParms( TwrPropsParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(TwrPropsParms), INTENT(INOUT) :: TwrPropsParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyTwrPropsParms' + LOGICAL,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 @@ -10523,15 +10735,27 @@ SUBROUTINE AD14_CopyWind( SrcWindData, DstWindData, CtrlCode, ErrStat, ErrMsg ) DstWindData%SDEL = SrcWindData%SDEL END SUBROUTINE AD14_CopyWind - SUBROUTINE AD14_DestroyWind( WindData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyWind( WindData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Wind), INTENT(INOUT) :: WindData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyWind' + LOGICAL,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 ) @@ -10674,15 +10898,27 @@ SUBROUTINE AD14_CopyWindParms( SrcWindParmsData, DstWindParmsData, CtrlCode, Err DstWindParmsData%KinVisc = SrcWindParmsData%KinVisc END SUBROUTINE AD14_CopyWindParms - SUBROUTINE AD14_DestroyWindParms( WindParmsData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyWindParms( WindParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WindParms), INTENT(INOUT) :: WindParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyWindParms' + LOGICAL,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 ) @@ -10805,15 +11041,27 @@ SUBROUTINE AD14_CopyPositionType( SrcPositionTypeData, DstPositionTypeData, Ctrl DstPositionTypeData%Pos = SrcPositionTypeData%Pos END SUBROUTINE AD14_CopyPositionType - SUBROUTINE AD14_DestroyPositionType( PositionTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyPositionType( PositionTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(PositionType), INTENT(INOUT) :: PositionTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyPositionType' + LOGICAL,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 ) @@ -10939,15 +11187,27 @@ SUBROUTINE AD14_CopyOrientationType( SrcOrientationTypeData, DstOrientationTypeD DstOrientationTypeData%Orient = SrcOrientationTypeData%Orient END SUBROUTINE AD14_CopyOrientationType - SUBROUTINE AD14_DestroyOrientationType( OrientationTypeData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyOrientationType( OrientationTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(OrientationType), INTENT(INOUT) :: OrientationTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOrientationType' + LOGICAL,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 ) @@ -11109,20 +11369,34 @@ SUBROUTINE AD14_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyInitInput - SUBROUTINE AD14_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD14_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInitInput' + LOGICAL,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 = "" - CALL AD14_Destroyaeroconfig( InitInputData%TurbineComponents, ErrStat, 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, ErrStat, ErrMsg ) + 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 ) @@ -11523,17 +11797,31 @@ SUBROUTINE AD14_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%AirDens = SrcInitOutputData%AirDens END SUBROUTINE AD14_CopyInitOutput - SUBROUTINE AD14_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD14_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInitOutput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) - CALL DWM_DestroyInitOutput( InitOutputData%DWM, ErrStat, 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 ) @@ -11823,16 +12111,29 @@ SUBROUTINE AD14_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyContState - SUBROUTINE AD14_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyContState' + LOGICAL,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 = "" - CALL DWM_DestroyContState( ContStateData%DWM, ErrStat, 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 ) @@ -12032,16 +12333,29 @@ SUBROUTINE AD14_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyDiscState - SUBROUTINE AD14_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDiscState' + LOGICAL,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 = "" - CALL DWM_DestroyDiscState( DiscStateData%DWM, ErrStat, 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 ) @@ -12241,16 +12555,29 @@ SUBROUTINE AD14_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyConstrState - SUBROUTINE AD14_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyConstrState' + LOGICAL,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 = "" - CALL DWM_DestroyConstrState( ConstrStateData%DWM, ErrStat, 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 ) @@ -12450,16 +12777,29 @@ SUBROUTINE AD14_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyOtherState - SUBROUTINE AD14_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD14_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOtherState' + LOGICAL,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 = "" - CALL DWM_DestroyOtherState( OtherStateData%DWM, ErrStat, 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 ) @@ -12752,29 +13092,52 @@ SUBROUTINE AD14_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_CopyMisc - SUBROUTINE AD14_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD14_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyMisc' + LOGICAL,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 = "" - CALL DWM_DestroyMisc( MiscData%DWM, ErrStat, ErrMsg ) - CALL DWM_DestroyInput( MiscData%DWM_Inputs, ErrStat, ErrMsg ) - CALL DWM_DestroyOutput( MiscData%DWM_Outputs, ErrStat, 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, ErrStat, ErrMsg ) - CALL AD14_Destroybeddoes( MiscData%Beddoes, ErrStat, ErrMsg ) - CALL AD14_Destroydyninflow( MiscData%DynInflow, ErrStat, ErrMsg ) - CALL AD14_Destroyelement( MiscData%Element, ErrStat, ErrMsg ) - CALL AD14_Destroyrotor( MiscData%Rotor, ErrStat, ErrMsg ) - CALL AD14_Destroywind( MiscData%Wind, ErrStat, ErrMsg ) - CALL AD14_Destroyinducedvel( MiscData%InducedVel, ErrStat, ErrMsg ) - CALL AD14_Destroyeloutparms( MiscData%ElOut, ErrStat, ErrMsg ) + 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 @@ -14119,25 +14482,47 @@ SUBROUTINE AD14_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyParam - SUBROUTINE AD14_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD14_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyParam' + LOGICAL,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 = "" - CALL AD14_Destroyairfoilparms( ParamData%AirFoil, ErrStat, ErrMsg ) - CALL AD14_Destroybladeparms( ParamData%Blade, ErrStat, ErrMsg ) - CALL AD14_Destroybeddoesparms( ParamData%Beddoes, ErrStat, ErrMsg ) - CALL AD14_Destroydyninflowparms( ParamData%DynInflow, ErrStat, ErrMsg ) - CALL AD14_Destroyelementparms( ParamData%Element, ErrStat, ErrMsg ) - CALL AD14_Destroytwrpropsparms( ParamData%TwrProps, ErrStat, ErrMsg ) - CALL AD14_Destroyinducedvelparms( ParamData%InducedVel, ErrStat, ErrMsg ) - CALL AD14_Destroywindparms( ParamData%Wind, ErrStat, ErrMsg ) - CALL AD14_Destroyrotorparms( ParamData%Rotor, ErrStat, ErrMsg ) - CALL DWM_DestroyParam( ParamData%DWM, ErrStat, 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 ) @@ -15281,23 +15666,38 @@ SUBROUTINE AD14_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%AvgInfVel = SrcInputData%AvgInfVel END SUBROUTINE AD14_CopyInput - SUBROUTINE AD14_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD14_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInput' + LOGICAL,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), ErrStat, ErrMsg ) + CALL MeshDestroy( InputData%InputMarkers(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputData%InputMarkers) ENDIF - CALL MeshDestroy( InputData%Twr_InputMarkers, ErrStat, ErrMsg ) - CALL AD14_Destroyaeroconfig( InputData%TurbineComponents, ErrStat, ErrMsg ) + 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 @@ -15834,22 +16234,36 @@ SUBROUTINE AD14_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyOutput - SUBROUTINE AD14_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE AD14_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AD14_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOutput' + LOGICAL,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), ErrStat, ErrMsg ) + CALL MeshDestroy( OutputData%OutputLoads(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%OutputLoads) ENDIF - CALL MeshDestroy( OutputData%Twr_OutputLoads, ErrStat, ErrMsg ) + 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 ) diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index a79aae3424..9e6784c86a 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -349,15 +349,27 @@ SUBROUTINE DWM_CopyCVSD( SrcCVSDData, DstCVSDData, CtrlCode, ErrStat, ErrMsg ) DstCVSDData%Numerator = SrcCVSDData%Numerator END SUBROUTINE DWM_CopyCVSD - SUBROUTINE DWM_DestroyCVSD( CVSDData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyCVSD( CVSDData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(CVSD), INTENT(INOUT) :: CVSDData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyCVSD' + LOGICAL,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 ) @@ -539,15 +551,27 @@ SUBROUTINE DWM_Copyturbine_average_velocity_data( Srcturbine_average_velocity_da 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 ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyturbine_average_velocity_data' + LOGICAL,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 @@ -859,15 +883,27 @@ SUBROUTINE DWM_CopyWake_Deficit_Data( SrcWake_Deficit_DataData, DstWake_Deficit_ DstWake_Deficit_DataData%ppR = SrcWake_Deficit_DataData%ppR END SUBROUTINE DWM_CopyWake_Deficit_Data - SUBROUTINE DWM_DestroyWake_Deficit_Data( Wake_Deficit_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyWake_Deficit_Data' + LOGICAL,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 @@ -1058,15 +1094,27 @@ SUBROUTINE DWM_CopyMeanderData( SrcMeanderDataData, DstMeanderDataData, CtrlCode DstMeanderDataData%moving_time = SrcMeanderDataData%moving_time END SUBROUTINE DWM_CopyMeanderData - SUBROUTINE DWM_DestroyMeanderData( MeanderDataData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyMeanderData( MeanderDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MeanderData), INTENT(INOUT) :: MeanderDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyMeanderData' + LOGICAL,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 ) @@ -1389,15 +1437,27 @@ SUBROUTINE DWM_Copyread_turbine_position_data( Srcread_turbine_position_dataData ENDIF END SUBROUTINE DWM_Copyread_turbine_position_data - SUBROUTINE DWM_Destroyread_turbine_position_data( read_turbine_position_dataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyread_turbine_position_data' + LOGICAL,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 @@ -2220,15 +2280,27 @@ SUBROUTINE DWM_CopyWeiMethod( SrcWeiMethodData, DstWeiMethodData, CtrlCode, ErrS DstWeiMethodData%weighting_denominator = SrcWeiMethodData%weighting_denominator END SUBROUTINE DWM_CopyWeiMethod - SUBROUTINE DWM_DestroyWeiMethod( WeiMethodData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyWeiMethod( WeiMethodData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WeiMethod), INTENT(INOUT) :: WeiMethodData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyWeiMethod' + LOGICAL,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 @@ -2431,15 +2503,27 @@ SUBROUTINE DWM_CopyTIDownstream( SrcTIDownstreamData, DstTIDownstreamData, CtrlC DstTIDownstreamData%temp3 = SrcTIDownstreamData%temp3 END SUBROUTINE DWM_CopyTIDownstream - SUBROUTINE DWM_DestroyTIDownstream( TIDownstreamData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyTIDownstream( TIDownstreamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(TIDownstream), INTENT(INOUT) :: TIDownstreamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyTIDownstream' + LOGICAL,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 @@ -2755,15 +2839,27 @@ SUBROUTINE DWM_CopyTurbKaimal( SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, E DstTurbKaimalData%STD = SrcTurbKaimalData%STD END SUBROUTINE DWM_CopyTurbKaimal - SUBROUTINE DWM_DestroyTurbKaimal( TurbKaimalData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyTurbKaimal( TurbKaimalData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(TurbKaimal), INTENT(INOUT) :: TurbKaimalData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyTurbKaimal' + LOGICAL,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 ) @@ -2978,15 +3074,27 @@ SUBROUTINE DWM_CopyShinozuka( SrcShinozukaData, DstShinozukaData, CtrlCode, ErrS DstShinozukaData%df = SrcShinozukaData%df END SUBROUTINE DWM_CopyShinozuka - SUBROUTINE DWM_DestroyShinozuka( ShinozukaData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyShinozuka( ShinozukaData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Shinozuka), INTENT(INOUT) :: ShinozukaData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyShinozuka' + LOGICAL,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 @@ -3344,15 +3452,27 @@ SUBROUTINE DWM_Copysmooth_out_wake_data( Srcsmooth_out_wake_dataData, Dstsmooth_ 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 ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroysmooth_out_wake_data' + LOGICAL,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 ) @@ -3474,15 +3594,27 @@ SUBROUTINE DWM_CopySWSV( SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg ) DstSWSVData%unit = SrcSWSVData%unit END SUBROUTINE DWM_CopySWSV - SUBROUTINE DWM_DestroySWSV( SWSVData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroySWSV( SWSVData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SWSV), INTENT(INOUT) :: SWSVData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroySWSV' + LOGICAL,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 ) @@ -3775,15 +3907,27 @@ SUBROUTINE DWM_Copyread_upwind_result( Srcread_upwind_resultData, Dstread_upwind ENDIF END SUBROUTINE DWM_Copyread_upwind_result - SUBROUTINE DWM_Destroyread_upwind_result( read_upwind_resultData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyread_upwind_result' + LOGICAL,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 @@ -4442,15 +4586,27 @@ SUBROUTINE DWM_Copywake_meandered_center( Srcwake_meandered_centerData, Dstwake_ ENDIF END SUBROUTINE DWM_Copywake_meandered_center - SUBROUTINE DWM_Destroywake_meandered_center( wake_meandered_centerData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroywake_meandered_center' + LOGICAL,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 @@ -4606,15 +4762,27 @@ SUBROUTINE DWM_Copyturbine_blade( Srcturbine_bladeData, Dstturbine_bladeData, Ct Dstturbine_bladeData%Element_index = Srcturbine_bladeData%Element_index END SUBROUTINE DWM_Copyturbine_blade - SUBROUTINE DWM_Destroyturbine_blade( turbine_bladeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyturbine_blade' + LOGICAL,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 ) @@ -4822,15 +4990,27 @@ SUBROUTINE DWM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyParam - SUBROUTINE DWM_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DWM_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyParam' + LOGICAL,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 @@ -4843,8 +5023,10 @@ SUBROUTINE DWM_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%ElementRad)) THEN DEALLOCATE(ParamData%ElementRad) ENDIF - CALL DWM_Destroyread_turbine_position_data( ParamData%RTPD, ErrStat, ErrMsg ) - CALL InflowWind_DestroyParam( ParamData%IfW, ErrStat, ErrMsg ) + 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 ) @@ -5409,16 +5591,29 @@ SUBROUTINE DWM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyOtherState - SUBROUTINE DWM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DWM_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyOtherState' + LOGICAL,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 = "" - CALL InflowWind_DestroyOtherState( OtherStateData%IfW, ErrStat, 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 ) @@ -5693,34 +5888,59 @@ SUBROUTINE DWM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyMisc - SUBROUTINE DWM_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DWM_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyMisc' + LOGICAL,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 = "" - CALL InflowWind_DestroyMisc( MiscData%IfW, ErrStat, 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, ErrStat, ErrMsg ) - CALL DWM_Destroycvsd( MiscData%CalVelScale_data, ErrStat, ErrMsg ) - CALL DWM_Destroymeanderdata( MiscData%meandering_data, ErrStat, ErrMsg ) - CALL DWM_Destroyweimethod( MiscData%weighting_method, ErrStat, ErrMsg ) - CALL DWM_Destroytidownstream( MiscData%TI_downstream_data, ErrStat, ErrMsg ) - CALL DWM_Destroyturbkaimal( MiscData%Turbulence_KS, ErrStat, ErrMsg ) - CALL DWM_Destroyshinozuka( MiscData%shinozuka_data, ErrStat, ErrMsg ) - CALL DWM_Destroysmooth_out_wake_data( MiscData%SmoothOut, ErrStat, ErrMsg ) - CALL DWM_Destroyswsv( MiscData%smooth_wake_shifted_velocity_data, ErrStat, ErrMsg ) - CALL DWM_Destroywake_deficit_data( MiscData%DWDD, ErrStat, ErrMsg ) - CALL DWM_Destroyturbine_blade( MiscData%DWM_tb, ErrStat, ErrMsg ) - CALL DWM_Destroywake_meandered_center( MiscData%WMC, ErrStat, ErrMsg ) + 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 ) @@ -7086,17 +7306,31 @@ SUBROUTINE DWM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyInput - SUBROUTINE DWM_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DWM_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInput' + LOGICAL,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 = "" - CALL DWM_Destroyread_upwind_result( InputData%Upwind_result, ErrStat, ErrMsg ) - CALL InflowWind_DestroyInput( InputData%IfW, ErrStat, 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 ) @@ -7496,15 +7730,27 @@ SUBROUTINE DWM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyOutput - SUBROUTINE DWM_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DWM_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyOutput' + LOGICAL,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 @@ -7529,7 +7775,8 @@ SUBROUTINE DWM_DestroyOutput( OutputData, ErrStat, ErrMsg ) IF (ALLOCATED(OutputData%smoothed_velocity_array)) THEN DEALLOCATE(OutputData%smoothed_velocity_array) ENDIF - CALL InflowWind_DestroyOutput( OutputData%IfW, ErrStat, ErrMsg ) + 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 ) @@ -8117,16 +8364,29 @@ SUBROUTINE DWM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyContState - SUBROUTINE DWM_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyContState' + LOGICAL,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 = "" - CALL InflowWind_DestroyContState( ContStateData%IfW, ErrStat, 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 ) @@ -8332,16 +8592,29 @@ SUBROUTINE DWM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyDiscState - SUBROUTINE DWM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyDiscState' + LOGICAL,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 = "" - CALL InflowWind_DestroyDiscState( DiscStateData%IfW, ErrStat, 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 ) @@ -8547,16 +8820,29 @@ SUBROUTINE DWM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyConstrState - SUBROUTINE DWM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyConstrState' + LOGICAL,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 = "" - CALL InflowWind_DestroyConstrState( ConstrStateData%IfW, ErrStat, 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 ) @@ -8762,16 +9048,29 @@ SUBROUTINE DWM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyInitInput - SUBROUTINE DWM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DWM_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInitInput' + LOGICAL,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 = "" - CALL InflowWind_DestroyInitInput( InitInputData%IfW, ErrStat, 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 ) @@ -8977,16 +9276,29 @@ SUBROUTINE DWM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyInitOutput - SUBROUTINE DWM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE DWM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(DWM_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInitOutput' + LOGICAL,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 = "" - CALL InflowWind_DestroyInitOutput( InitOutputData%IfW, ErrStat, 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 ) diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index d6ade6de2e..a102d99239 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -279,15 +279,27 @@ SUBROUTINE AWAE_CopyHighWindGrid( SrcHighWindGridData, DstHighWindGridData, Ctrl ENDIF END SUBROUTINE AWAE_CopyHighWindGrid - SUBROUTINE AWAE_DestroyHighWindGrid( HighWindGridData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyHighWindGrid( HighWindGridData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_HighWindGrid), INTENT(INOUT) :: HighWindGridData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyHighWindGrid' + LOGICAL,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 @@ -637,15 +649,27 @@ SUBROUTINE AWAE_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, C ENDIF END SUBROUTINE AWAE_CopyInputFileType - SUBROUTINE AWAE_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_InputFileType), INTENT(INOUT) :: InputFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInputFileType' + LOGICAL,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 @@ -1337,16 +1361,29 @@ SUBROUTINE AWAE_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot END SUBROUTINE AWAE_CopyInitInput - SUBROUTINE AWAE_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInitInput' + LOGICAL,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 = "" - CALL AWAE_Destroyinputfiletype( InitInputData%InputFileData, ErrStat, 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 ) @@ -1650,16 +1687,29 @@ SUBROUTINE AWAE_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low END SUBROUTINE AWAE_CopyInitOutput - SUBROUTINE AWAE_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInitOutput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 @@ -2180,18 +2230,31 @@ SUBROUTINE AWAE_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err ENDIF END SUBROUTINE AWAE_CopyContState - SUBROUTINE AWAE_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyContState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL InflowWind_DestroyContState( ContStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%IfW) ENDIF @@ -2444,18 +2507,31 @@ SUBROUTINE AWAE_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err ENDIF END SUBROUTINE AWAE_CopyDiscState - SUBROUTINE AWAE_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyDiscState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL InflowWind_DestroyDiscState( DiscStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DiscStateData%IfW) ENDIF @@ -2708,18 +2784,31 @@ SUBROUTINE AWAE_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod ENDIF END SUBROUTINE AWAE_CopyConstrState - SUBROUTINE AWAE_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyConstrState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL InflowWind_DestroyConstrState( ConstrStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ConstrStateData%IfW) ENDIF @@ -2972,18 +3061,31 @@ SUBROUTINE AWAE_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ENDIF END SUBROUTINE AWAE_CopyOtherState - SUBROUTINE AWAE_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyOtherState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL InflowWind_DestroyOtherState( OtherStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%IfW) ENDIF @@ -3529,15 +3631,27 @@ SUBROUTINE AWAE_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AWAE_CopyMisc - SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyMisc' + LOGICAL,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 @@ -3549,7 +3663,8 @@ SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + CALL AWAE_Destroyhighwindgrid( MiscData%Vamb_High(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%Vamb_High) ENDIF @@ -3597,14 +3712,19 @@ SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(MiscData%IfW)) THEN DO i1 = LBOUND(MiscData%IfW,1), UBOUND(MiscData%IfW,1) - CALL InflowWind_DestroyMisc( MiscData%IfW(i1), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL InflowWind_DestroyInput( MiscData%u_IfW_High, ErrStat, ErrMsg ) - CALL InflowWind_DestroyOutput( MiscData%y_IfW_Low, ErrStat, ErrMsg ) - CALL InflowWind_DestroyOutput( MiscData%y_IfW_High, ErrStat, ErrMsg ) + 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 ) @@ -5455,15 +5575,27 @@ SUBROUTINE AWAE_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth END SUBROUTINE AWAE_CopyParam - SUBROUTINE AWAE_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyParam' + LOGICAL,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%r)) THEN DEALLOCATE(ParamData%r) ENDIF @@ -5496,7 +5628,8 @@ SUBROUTINE AWAE_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%IfW)) THEN DO i1 = LBOUND(ParamData%IfW,1), UBOUND(ParamData%IfW,1) - CALL InflowWind_DestroyParam( ParamData%IfW(i1), ErrStat, ErrMsg ) + CALL InflowWind_DestroyParam( ParamData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%IfW) ENDIF @@ -6534,18 +6667,31 @@ SUBROUTINE AWAE_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE AWAE_CopyOutput - SUBROUTINE AWAE_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyOutput' + LOGICAL,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), ErrStat, ErrMsg ) + CALL AWAE_Destroyhighwindgrid( OutputData%Vdist_High(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%Vdist_High) ENDIF @@ -7007,15 +7153,27 @@ SUBROUTINE AWAE_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE AWAE_CopyInput - SUBROUTINE AWAE_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE AWAE_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(AWAE_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInput' + LOGICAL,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 diff --git a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 index 9cc98cb5d4..7cc98b7a03 100644 --- a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 @@ -27,7 +27,7 @@ MODULE BeamDyn_BldNdOuts_IO ! Parameters related to output length (number of characters allowed in the output data headers): - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen-6 ! We are making these of the form B1Z###quantity, but note that the glue code adds the "B1" (turbine component) part +! INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen-6 ! We are making these of the form B1Z###quantity, but note that the glue code adds the "B1" (turbine component) part ! =================================================================================================== ! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index c497b3f198..1558f29290 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -44,11 +44,6 @@ MODULE BeamDyn_IO ! This code was generated by Write_ChckOutLst.m at 29-Sep-2015 10:23:41. - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - ! Indices for computing output channels: ! NOTES: ! (1) These parameters are in the order stored in "OutListParameters.xlsx" diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 196dfafaa3..2e38e89c90 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -366,15 +366,27 @@ SUBROUTINE BD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%DynamicSolve = SrcInitInputData%DynamicSolve END SUBROUTINE BD_CopyInitInput - SUBROUTINE BD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInitInput' + LOGICAL,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 ) @@ -763,22 +775,35 @@ SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er ENDIF END SUBROUTINE BD_CopyInitOutput - SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInitOutput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 @@ -1508,15 +1533,27 @@ SUBROUTINE BD_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, DstBladeInputDataData%damp_flag = SrcBladeInputDataData%damp_flag END SUBROUTINE BD_CopyBladeInputData - SUBROUTINE BD_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BladeInputData), INTENT(INOUT) :: BladeInputDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyBladeInputData' + LOGICAL,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 @@ -1917,19 +1954,32 @@ SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str END SUBROUTINE BD_CopyInputFile - SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BD_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInputFile' + LOGICAL,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, ErrStat, ErrMsg ) + 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 @@ -2551,15 +2601,27 @@ SUBROUTINE BD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE BD_CopyContState - SUBROUTINE BD_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyContState' + LOGICAL,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 @@ -2776,15 +2838,27 @@ SUBROUTINE BD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt DstDiscStateData%thetaPD = SrcDiscStateData%thetaPD END SUBROUTINE BD_CopyDiscState - SUBROUTINE BD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyDiscState' + LOGICAL,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 ) @@ -2906,15 +2980,27 @@ SUBROUTINE BD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE BD_CopyConstrState - SUBROUTINE BD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyConstrState' + LOGICAL,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 ) @@ -3062,15 +3148,27 @@ SUBROUTINE BD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%RunQuasiStaticInit = SrcOtherStateData%RunQuasiStaticInit END SUBROUTINE BD_CopyOtherState - SUBROUTINE BD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyOtherState' + LOGICAL,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 @@ -3328,15 +3426,27 @@ SUBROUTINE BD_CopyqpParam( SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, Er ENDIF END SUBROUTINE BD_CopyqpParam - SUBROUTINE BD_DestroyqpParam( qpParamData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyqpParam( qpParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(qpParam), INTENT(INOUT) :: qpParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyqpParam' + LOGICAL,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 @@ -4024,15 +4134,27 @@ SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%RelStates = SrcParamData%RelStates END SUBROUTINE BD_CopyParam - SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyParam' + LOGICAL,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 @@ -4077,7 +4199,8 @@ SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -4090,10 +4213,12 @@ SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%OutNd2NdElem)) THEN DEALLOCATE(ParamData%OutNd2NdElem) ENDIF - CALL BD_Destroyqpparam( ParamData%qp, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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 @@ -6207,19 +6332,35 @@ SUBROUTINE BD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE BD_CopyInput - SUBROUTINE BD_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInput' + LOGICAL,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 = "" - CALL MeshDestroy( InputData%RootMotion, ErrStat, ErrMsg ) - CALL MeshDestroy( InputData%PointLoad, ErrStat, ErrMsg ) - CALL MeshDestroy( InputData%DistrLoad, ErrStat, ErrMsg ) - CALL MeshDestroy( InputData%HubMotion, ErrStat, 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 ) @@ -6692,17 +6833,31 @@ SUBROUTINE BD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE BD_CopyOutput - SUBROUTINE BD_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyOutput' + LOGICAL,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 = "" - CALL MeshDestroy( OutputData%ReactionForce, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%BldMotion, ErrStat, 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 @@ -7570,15 +7725,27 @@ SUBROUTINE BD_CopyEqMotionQP( SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Er ENDIF END SUBROUTINE BD_CopyEqMotionQP - SUBROUTINE BD_DestroyEqMotionQP( EqMotionQPData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyEqMotionQP( EqMotionQPData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(EqMotionQP), INTENT(INOUT) :: EqMotionQPData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyEqMotionQP' + LOGICAL,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 @@ -10234,20 +10401,37 @@ SUBROUTINE BD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE BD_CopyMisc - SUBROUTINE BD_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE BD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyMisc' + LOGICAL,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 = "" - CALL MeshDestroy( MiscData%u_DistrLoad_at_y, ErrStat, ErrMsg ) - CALL MeshDestroy( MiscData%y_BldMotion_at_u, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Map_u_DistrLoad_to_y, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Map_y_BldMotion_to_u, ErrStat, ErrMsg ) - CALL BD_Destroyeqmotionqp( MiscData%qp, ErrStat, 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 @@ -10338,8 +10522,10 @@ SUBROUTINE BD_DestroyMisc( MiscData, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%LP_indx)) THEN DEALLOCATE(MiscData%LP_indx) ENDIF - CALL BD_DestroyInput( MiscData%u, ErrStat, ErrMsg ) - CALL BD_DestroyInput( MiscData%u2, ErrStat, ErrMsg ) + 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 ) diff --git a/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 index 91c2ed0669..adbbd13201 100644 --- a/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 @@ -20,7 +20,7 @@ MODULE ElastoDyn_AllBldNdOuts_IO ! Parameters related to output length (number of characters allowed in the output data headers): - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen-6 ! The NREL allowed channel name length is usually 20. We are making these of the form B#N###namesuffix +! INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen-6 ! The NREL allowed channel name length is usually 20. We are making these of the form B#N###namesuffix ! =================================================================================================== diff --git a/modules/elastodyn/src/ElastoDyn_IO.f90 b/modules/elastodyn/src/ElastoDyn_IO.f90 index 376792d54b..67687cf546 100644 --- a/modules/elastodyn/src/ElastoDyn_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_IO.f90 @@ -104,11 +104,6 @@ MODULE ElastoDyn_Parameters ! This code was generated by Write_ChckOutLst.m at 25-Jan-2021 13:23:51. - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - ! Indices for computing output channels: ! NOTES: ! (1) These parameters are in the order stored in "OutListParameters.xlsx" diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 03ba6296e4..a840347fc2 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -906,15 +906,27 @@ SUBROUTINE ED_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%Gravity = SrcInitInputData%Gravity END SUBROUTINE ED_CopyInitInput - SUBROUTINE ED_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInitInput' + LOGICAL,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 ) @@ -1246,22 +1258,35 @@ SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er ENDIF END SUBROUTINE ED_CopyInitOutput - SUBROUTINE ED_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInitOutput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 @@ -2359,15 +2384,27 @@ SUBROUTINE ED_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, ENDIF END SUBROUTINE ED_CopyBladeInputData - SUBROUTINE ED_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BladeInputData), INTENT(INOUT) :: BladeInputDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyBladeInputData' + LOGICAL,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 @@ -3375,15 +3412,27 @@ SUBROUTINE ED_CopyBladeMeshInputData( SrcBladeMeshInputDataData, DstBladeMeshInp ENDIF END SUBROUTINE ED_CopyBladeMeshInputData - SUBROUTINE ED_DestroyBladeMeshInputData( BladeMeshInputDataData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyBladeMeshInputData( BladeMeshInputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_BladeMeshInputData), INTENT(INOUT) :: BladeMeshInputDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyBladeMeshInputData' + LOGICAL,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 @@ -4044,15 +4093,27 @@ SUBROUTINE ED_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut END SUBROUTINE ED_CopyInputFile - SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInputFile' + LOGICAL,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 @@ -4064,13 +4125,15 @@ SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%InpBlMesh)) THEN DO i1 = LBOUND(InputFileData%InpBlMesh,1), UBOUND(InputFileData%InpBlMesh,1) - CALL ED_Destroyblademeshinputdata( InputFileData%InpBlMesh(i1), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL ED_Destroybladeinputdata( InputFileData%InpBl(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputFileData%InpBl) ENDIF @@ -6356,15 +6419,27 @@ SUBROUTINE ED_CopyCoordSys( SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%z3 = SrcCoordSysData%z3 END SUBROUTINE ED_CopyCoordSys - SUBROUTINE ED_DestroyCoordSys( CoordSysData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyCoordSys( CoordSysData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_CoordSys), INTENT(INOUT) :: CoordSysData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyCoordSys' + LOGICAL,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 @@ -8065,15 +8140,27 @@ SUBROUTINE ED_CopyActiveDOFs( SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Er ENDIF END SUBROUTINE ED_CopyActiveDOFs - SUBROUTINE ED_DestroyActiveDOFs( ActiveDOFsData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyActiveDOFs( ActiveDOFsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_ActiveDOFs), INTENT(INOUT) :: ActiveDOFsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyActiveDOFs' + LOGICAL,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 @@ -10013,15 +10100,27 @@ SUBROUTINE ED_CopyRtHndSide( SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSt ENDIF END SUBROUTINE ED_CopyRtHndSide - SUBROUTINE ED_DestroyRtHndSide( RtHndSideData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyRtHndSide( RtHndSideData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_RtHndSide), INTENT(INOUT) :: RtHndSideData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyRtHndSide' + LOGICAL,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 @@ -14981,15 +15080,27 @@ SUBROUTINE ED_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE ED_CopyContState - SUBROUTINE ED_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyContState' + LOGICAL,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 @@ -15184,15 +15295,27 @@ SUBROUTINE ED_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE ED_CopyDiscState - SUBROUTINE ED_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyDiscState' + LOGICAL,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 ) @@ -15309,15 +15432,27 @@ SUBROUTINE ED_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE ED_CopyConstrState - SUBROUTINE ED_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyConstrState' + LOGICAL,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 ) @@ -15456,17 +15591,30 @@ SUBROUTINE ED_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%SgnLSTQ = SrcOtherStateData%SgnLSTQ END SUBROUTINE ED_CopyOtherState - SUBROUTINE ED_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyOtherState' + LOGICAL,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), ErrStat, ErrMsg ) + 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) @@ -15842,17 +15990,31 @@ SUBROUTINE ED_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod END SUBROUTINE ED_CopyMisc - SUBROUTINE ED_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyMisc' + LOGICAL,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 = "" - CALL ED_Destroycoordsys( MiscData%CoordSys, ErrStat, ErrMsg ) - CALL ED_Destroyrthndside( MiscData%RtHS, ErrStat, 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 @@ -17649,15 +17811,27 @@ SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%Jac_ny = SrcParamData%Jac_ny END SUBROUTINE ED_CopyParam - SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyParam' + LOGICAL,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 @@ -17670,10 +17844,12 @@ SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%DOF_Desc)) THEN DEALLOCATE(ParamData%DOF_Desc) ENDIF - CALL ED_Destroyactivedofs( ParamData%DOFs, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -17877,7 +18053,8 @@ SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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 @@ -22693,25 +22870,42 @@ SUBROUTINE ED_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC END SUBROUTINE ED_CopyInput - SUBROUTINE ED_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInput' + LOGICAL,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), ErrStat, ErrMsg ) + CALL MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputData%BladePtLoads) ENDIF - CALL MeshDestroy( InputData%PlatformPtMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( InputData%TowerPtLoads, ErrStat, ErrMsg ) - CALL MeshDestroy( InputData%HubPtLoad, ErrStat, ErrMsg ) - CALL MeshDestroy( InputData%NacelleLoads, ErrStat, ErrMsg ) + 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) IF (ALLOCATED(InputData%TwrAddedMass)) THEN DEALLOCATE(InputData%TwrAddedMass) ENDIF @@ -23527,35 +23721,57 @@ SUBROUTINE ED_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%LSShftFzs = SrcOutputData%LSShftFzs END SUBROUTINE ED_CopyOutput - SUBROUTINE ED_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE ED_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ED_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyOutput' + LOGICAL,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), ErrStat, ErrMsg ) + CALL MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%BladeLn2Mesh) ENDIF - CALL MeshDestroy( OutputData%PlatformPtMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%TowerLn2Mesh, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%HubPtMotion14, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%HubPtMotion, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%BladeRootMotion14, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%BladeRootMotion) ENDIF - CALL MeshDestroy( OutputData%RotorFurlMotion14, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%NacelleMotion, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%TowerBaseMotion14, ErrStat, ErrMsg ) + 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) IF (ALLOCATED(OutputData%WriteOutput)) THEN DEALLOCATE(OutputData%WriteOutput) ENDIF diff --git a/modules/extptfm/src/ExtPtfm_MCKF_IO.f90 b/modules/extptfm/src/ExtPtfm_MCKF_IO.f90 index d0e2868d13..ea954a9ae8 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_IO.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_IO.f90 @@ -40,7 +40,6 @@ MODULE ExtPtfm_MCKF_Parameters ! Variables for output channels INTEGER(IntKi), PARAMETER :: MaxOutChs = 9 + 3*200 ! Maximum number of output channels ! Harcoded to outputs of 200 CB modes - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 INTEGER(IntKi), PARAMETER :: ID_Time = 0 INTEGER(IntKi), PARAMETER :: ID_PtfFx = 1 INTEGER(IntKi), PARAMETER :: ID_PtfFy = 2 diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index aac3e92fbc..6e9a1eccc8 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -177,15 +177,27 @@ SUBROUTINE ExtPtfm_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%RootName = SrcInitInputData%RootName END SUBROUTINE ExtPtfm_CopyInitInput - SUBROUTINE ExtPtfm_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ExtPtfm_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInitInput' + LOGICAL,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 ) @@ -387,15 +399,27 @@ SUBROUTINE ExtPtfm_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ENDIF END SUBROUTINE ExtPtfm_CopyInputFile - SUBROUTINE ExtPtfm_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInputFile' + LOGICAL,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 @@ -871,16 +895,29 @@ SUBROUTINE ExtPtfm_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCod ENDIF END SUBROUTINE ExtPtfm_CopyInitOutput - SUBROUTINE ExtPtfm_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInitOutput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 @@ -1533,15 +1570,27 @@ SUBROUTINE ExtPtfm_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ENDIF END SUBROUTINE ExtPtfm_CopyContState - SUBROUTINE ExtPtfm_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyContState' + LOGICAL,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 @@ -1736,15 +1785,27 @@ SUBROUTINE ExtPtfm_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE ExtPtfm_CopyDiscState - SUBROUTINE ExtPtfm_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyDiscState' + LOGICAL,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 ) @@ -1861,15 +1922,27 @@ SUBROUTINE ExtPtfm_CopyConstrState( SrcConstrStateData, DstConstrStateData, Ctrl DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE ExtPtfm_CopyConstrState - SUBROUTINE ExtPtfm_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyConstrState' + LOGICAL,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 ) @@ -2003,18 +2076,31 @@ SUBROUTINE ExtPtfm_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCod DstOtherStateData%n = SrcOtherStateData%n END SUBROUTINE ExtPtfm_CopyOtherState - SUBROUTINE ExtPtfm_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyOtherState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL ExtPtfm_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%xdot) ENDIF @@ -2295,15 +2381,27 @@ SUBROUTINE ExtPtfm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE ExtPtfm_CopyMisc - SUBROUTINE ExtPtfm_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyMisc' + LOGICAL,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 @@ -2898,15 +2996,27 @@ SUBROUTINE ExtPtfm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE ExtPtfm_CopyParam - SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyParam' + LOGICAL,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 @@ -2975,7 +3085,8 @@ SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -4317,16 +4428,29 @@ SUBROUTINE ExtPtfm_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE ExtPtfm_CopyInput - SUBROUTINE ExtPtfm_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ExtPtfm_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInput' + LOGICAL,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 = "" - CALL MeshDestroy( InputData%PtfmMesh, ErrStat, 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 ) @@ -4539,16 +4663,29 @@ SUBROUTINE ExtPtfm_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ENDIF END SUBROUTINE ExtPtfm_CopyOutput - SUBROUTINE ExtPtfm_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyOutput' + LOGICAL,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 = "" - CALL MeshDestroy( OutputData%PtfmMesh, ErrStat, 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 diff --git a/modules/feamooring/src/FEAM.f90 b/modules/feamooring/src/FEAM.f90 index f1e541e6e7..a97aeee76b 100644 --- a/modules/feamooring/src/FEAM.f90 +++ b/modules/feamooring/src/FEAM.f90 @@ -35,11 +35,6 @@ MODULE FEAMooring ! This code was generated by Write_ChckOutLst.m at 09-Dec-2014 14:03:37. - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - ! Indices for computing output channels: ! NOTES: ! (1) These parameters are in the order stored in "OutListParameters.xlsx" diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index ffed532365..46cb3bec12 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -483,15 +483,27 @@ SUBROUTINE FEAM_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err ENDIF END SUBROUTINE FEAM_CopyInputFile - SUBROUTINE FEAM_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE FEAM_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FEAM_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInputFile' + LOGICAL,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 @@ -1520,15 +1532,27 @@ SUBROUTINE FEAM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WtrDens = SrcInitInputData%WtrDens END SUBROUTINE FEAM_CopyInitInput - SUBROUTINE FEAM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE FEAM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FEAM_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInitInput' + LOGICAL,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 @@ -1949,22 +1973,35 @@ SUBROUTINE FEAM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ENDIF END SUBROUTINE FEAM_CopyInitOutput - SUBROUTINE FEAM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE FEAM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FEAM_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInitOutput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 @@ -2522,15 +2559,27 @@ SUBROUTINE FEAM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err ENDIF END SUBROUTINE FEAM_CopyContState - SUBROUTINE FEAM_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE FEAM_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FEAM_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyContState' + LOGICAL,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 @@ -2746,15 +2795,27 @@ SUBROUTINE FEAM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE FEAM_CopyDiscState - SUBROUTINE FEAM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE FEAM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FEAM_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyDiscState' + LOGICAL,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 ) @@ -2873,15 +2934,27 @@ SUBROUTINE FEAM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod DstConstrStateData%TZER = SrcConstrStateData%TZER END SUBROUTINE FEAM_CopyConstrState - SUBROUTINE FEAM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE FEAM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FEAM_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyConstrState' + LOGICAL,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 ) @@ -3114,15 +3187,27 @@ SUBROUTINE FEAM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%EMAS0 = SrcOtherStateData%EMAS0 END SUBROUTINE FEAM_CopyOtherState - SUBROUTINE FEAM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE FEAM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FEAM_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyOtherState' + LOGICAL,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 @@ -3781,15 +3866,27 @@ SUBROUTINE FEAM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%LastIndWave = SrcMiscData%LastIndWave END SUBROUTINE FEAM_CopyMisc - SUBROUTINE FEAM_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE FEAM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FEAM_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyMisc' + LOGICAL,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 @@ -4893,15 +4990,27 @@ SUBROUTINE FEAM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE FEAM_CopyParam - SUBROUTINE FEAM_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE FEAM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FEAM_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyParam' + LOGICAL,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 @@ -4949,7 +5058,8 @@ SUBROUTINE FEAM_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -6320,17 +6430,31 @@ SUBROUTINE FEAM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FEAM_CopyInput - SUBROUTINE FEAM_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE FEAM_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FEAM_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInput' + LOGICAL,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 = "" - CALL MeshDestroy( InputData%HydroForceLineMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( InputData%PtFairleadDisplacement, ErrStat, 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 ) @@ -6631,20 +6755,34 @@ SUBROUTINE FEAM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FEAM_CopyOutput - SUBROUTINE FEAM_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE FEAM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FEAM_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyOutput' + LOGICAL,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, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%LineMeshPosition, ErrStat, ErrMsg ) + 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 ) diff --git a/modules/hydrodyn/python-lib/hydrodyn_library.py b/modules/hydrodyn/python-lib/hydrodyn_library.py index b52e2eb74f..f9abfff7b2 100644 --- a/modules/hydrodyn/python-lib/hydrodyn_library.py +++ b/modules/hydrodyn/python-lib/hydrodyn_library.py @@ -421,6 +421,7 @@ def check_error(self): def check_input_motions(self,nodePos,nodeVel,nodeAcc): # make sure number of nodes didn't change for some reason if self._initNumNodePts != self.numNodePts: + # @ANDY TODO: `time` is not available here so this would be a runtime error print(f"At time {time}, the number of node points changed from initial value of {self._initNumNodePts}. This is not permitted during the simulation.") self.hydrodyn_end() raise Exception("\nError in calling HydroDyn library.") @@ -594,7 +595,7 @@ def __init__(self,filename,chan_names,chan_units): # write file header t_string=datetime.datetime.now() dt_string=datetime.date.today() - self.OutFile.write(f"## This file was generated by InflowWind_Driver on {dt_string.strftime('%b-%d-%Y')} at {t_string.strftime('%H:%M:%S')}\n") + self.OutFile.write(f"## This file was generated by HydroDyn_Driver on {dt_string.strftime('%b-%d-%Y')} at {t_string.strftime('%H:%M:%S')}\n") self.OutFile.write(f"## This file contains output channels requested from the OutList section of the input file") self.OutFile.write(f"{filename}\n") self.OutFile.write("#\n") diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index d9188b01d3..4c69b4d103 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -171,15 +171,27 @@ SUBROUTINE Conv_Rdtn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode DstInitInputData%UnSum = SrcInitInputData%UnSum END SUBROUTINE Conv_Rdtn_CopyInitInput - SUBROUTINE Conv_Rdtn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE Conv_Rdtn_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Conv_Rdtn_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInitInput' + LOGICAL,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 @@ -505,15 +517,27 @@ SUBROUTINE Conv_Rdtn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut END SUBROUTINE Conv_Rdtn_CopyInitOutput - SUBROUTINE Conv_Rdtn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE Conv_Rdtn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Conv_Rdtn_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInitOutput' + LOGICAL,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 ) @@ -630,15 +654,27 @@ SUBROUTINE Conv_Rdtn_CopyContState( SrcContStateData, DstContStateData, CtrlCode DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE Conv_Rdtn_CopyContState - SUBROUTINE Conv_Rdtn_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE Conv_Rdtn_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Conv_Rdtn_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyContState' + LOGICAL,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 ) @@ -771,15 +807,27 @@ SUBROUTINE Conv_Rdtn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode DstDiscStateData%LastTime = SrcDiscStateData%LastTime END SUBROUTINE Conv_Rdtn_CopyDiscState - SUBROUTINE Conv_Rdtn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE Conv_Rdtn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Conv_Rdtn_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyDiscState' + LOGICAL,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 @@ -949,15 +997,27 @@ SUBROUTINE Conv_Rdtn_CopyConstrState( SrcConstrStateData, DstConstrStateData, Ct DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE Conv_Rdtn_CopyConstrState - SUBROUTINE Conv_Rdtn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE Conv_Rdtn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Conv_Rdtn_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyConstrState' + LOGICAL,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 ) @@ -1074,15 +1134,27 @@ SUBROUTINE Conv_Rdtn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlC DstOtherStateData%IndRdtn = SrcOtherStateData%IndRdtn END SUBROUTINE Conv_Rdtn_CopyOtherState - SUBROUTINE Conv_Rdtn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE Conv_Rdtn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyOtherState' + LOGICAL,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 ) @@ -1199,15 +1271,27 @@ SUBROUTINE Conv_Rdtn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM DstMiscData%LastIndRdtn = SrcMiscData%LastIndRdtn END SUBROUTINE Conv_Rdtn_CopyMisc - SUBROUTINE Conv_Rdtn_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE Conv_Rdtn_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyMisc' + LOGICAL,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 ) @@ -1347,15 +1431,27 @@ SUBROUTINE Conv_Rdtn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%NStepRdtn1 = SrcParamData%NStepRdtn1 END SUBROUTINE Conv_Rdtn_CopyParam - SUBROUTINE Conv_Rdtn_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE Conv_Rdtn_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Conv_Rdtn_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyParam' + LOGICAL,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 @@ -1568,15 +1664,27 @@ SUBROUTINE Conv_Rdtn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, E ENDIF END SUBROUTINE Conv_Rdtn_CopyInput - SUBROUTINE Conv_Rdtn_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE Conv_Rdtn_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInput' + LOGICAL,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 @@ -1742,15 +1850,27 @@ SUBROUTINE Conv_Rdtn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat ENDIF END SUBROUTINE Conv_Rdtn_CopyOutput - SUBROUTINE Conv_Rdtn_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE Conv_Rdtn_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyOutput' + LOGICAL,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 diff --git a/modules/hydrodyn/src/Current_Types.f90 b/modules/hydrodyn/src/Current_Types.f90 index f262434bca..a768b5d0b3 100644 --- a/modules/hydrodyn/src/Current_Types.f90 +++ b/modules/hydrodyn/src/Current_Types.f90 @@ -140,15 +140,27 @@ SUBROUTINE Current_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%DirRoot = SrcInitInputData%DirRoot END SUBROUTINE Current_CopyInitInput - SUBROUTINE Current_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE Current_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Current_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitInput' + LOGICAL,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 @@ -396,15 +408,27 @@ SUBROUTINE Current_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%PCurrVyiPz0 = SrcInitOutputData%PCurrVyiPz0 END SUBROUTINE Current_CopyInitOutput - SUBROUTINE Current_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE Current_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Current_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitOutput' + LOGICAL,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 @@ -609,15 +633,27 @@ SUBROUTINE Current_CopyContState( SrcContStateData, DstContStateData, CtrlCode, DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE Current_CopyContState - SUBROUTINE Current_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE Current_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Current_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyContState' + LOGICAL,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 ) @@ -734,15 +770,27 @@ SUBROUTINE Current_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE Current_CopyDiscState - SUBROUTINE Current_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE Current_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Current_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyDiscState' + LOGICAL,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 ) @@ -859,15 +907,27 @@ SUBROUTINE Current_CopyConstrState( SrcConstrStateData, DstConstrStateData, Ctrl DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE Current_CopyConstrState - SUBROUTINE Current_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE Current_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Current_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyConstrState' + LOGICAL,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 ) @@ -984,15 +1044,27 @@ SUBROUTINE Current_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCod DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE Current_CopyOtherState - SUBROUTINE Current_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE Current_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Current_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyOtherState' + LOGICAL,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 ) @@ -1109,15 +1181,27 @@ SUBROUTINE Current_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE Current_CopyMisc - SUBROUTINE Current_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE Current_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Current_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyMisc' + LOGICAL,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 ) @@ -1234,15 +1318,27 @@ SUBROUTINE Current_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%DT = SrcParamData%DT END SUBROUTINE Current_CopyParam - SUBROUTINE Current_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE Current_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Current_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyParam' + LOGICAL,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 ) @@ -1359,15 +1455,27 @@ SUBROUTINE Current_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, Err DstInputData%DummyInput = SrcInputData%DummyInput END SUBROUTINE Current_CopyInput - SUBROUTINE Current_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE Current_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Current_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInput' + LOGICAL,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 ) @@ -1484,15 +1592,27 @@ SUBROUTINE Current_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, DstOutputData%DummyOutput = SrcOutputData%DummyOutput END SUBROUTINE Current_CopyOutput - SUBROUTINE Current_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE Current_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Current_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyOutput' + LOGICAL,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 ) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 1f8cedf0ee..2c05caa186 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -442,11 +442,14 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! 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 + ! 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 ! Now call each sub-module's *_Init subroutine ! to fully initialize each sub-module based on the necessary initialization data @@ -1355,10 +1358,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I 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 diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 038fc676a1..541a6dbcce 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -84,6 +84,7 @@ typedef ^ ^ ReKi 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" # @@ -107,6 +108,12 @@ typedef ^ ^ CHARACTER(L 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)" - diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 3dadca82ba..fcbac6fa6c 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1262,8 +1262,7 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp call AllocAry( InputFileData%UserOutputs, MaxUserOutputs, 'InputFileData%UserOutputs', ErrStat2, ErrMsg2 ) ! MaxUserOutputs is set in registry if (Failed()) return; - call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%UserOutputs, & - InputFileData%NUserOutputs, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) + call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%UserOutputs, InputFileData%NUserOutputs, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; @@ -1313,6 +1312,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS 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 @@ -1483,7 +1483,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS ! WaveTMax - Analysis time for incident wave calculations. - IF ( InputFileData%Waves%WaveMod == 0 ) THEN ! .TRUE if we have incident waves. + 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 @@ -3223,7 +3223,6 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS 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 diff --git a/modules/hydrodyn/src/HydroDyn_Output.f90 b/modules/hydrodyn/src/HydroDyn_Output.f90 index fc1c73e6bc..44668a17c7 100644 --- a/modules/hydrodyn/src/HydroDyn_Output.f90 +++ b/modules/hydrodyn/src/HydroDyn_Output.f90 @@ -34,13 +34,7 @@ MODULE HydroDyn_Output ! 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 05-Jan-2021 06:02:16. - - - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - +! This code was generated by "Write_ChckOutLst.m" at 07-Sep-2022 15:24:58. ! Indices for computing output channels: ! NOTES: @@ -612,8 +606,8 @@ MODULE HydroDyn_Output ! The maximum number of output channels which can be output by the code. INTEGER(IntKi), PARAMETER :: MaxOutPts = 537 -!End of code generated by Matlab script -! =================================================================================================== +!End of code generated by Matlab script Write_ChckOutLst +! =================================================================================================== REAL(ReKi) :: AllOuts(MaxHDOutputs) ! Array of all possible outputs @@ -1232,7 +1226,7 @@ SUBROUTINE HDOut_WriteOutputs( Time, y, p, Decimate, ErrStat, ErrMsg ) INTEGER :: I ! Generic loop counter CHARACTER(200) :: Frmt ! a string to hold a format statement integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 +! character(ErrMsgLen) :: ErrMsg2 IF (p%UnOutFile < 0 ) RETURN @@ -1343,7 +1337,7 @@ SUBROUTINE HDOUT_Init( HydroDyn_ProgDesc, OutRootName, InputFileData, y, p, m, CALL HDOUT_ChkOutLst( InputFileData%OutList(1:p%NumOuts), y, p, ErrStat, ErrMsg ) - IF ( ErrStat /= 0 ) RETURN + IF ( ErrStat >= AbortErrLev ) RETURN ! Aggregate the sub-module initialization outputs for the glue code @@ -1597,13 +1591,13 @@ FUNCTION HDOut_GetChannels ( NUserOutputs, UserOutputs, OutList, foundMask, CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case - Indx = IndexCharAry( OutListTmp(1:9), ValidParamAry ) + 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:9), ValidParamAry ) + Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) END IF IF ( Indx > 0 ) THEN diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 3397982a00..4777387fd3 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -95,6 +95,7 @@ MODULE HydroDyn_Types 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] END TYPE HydroDyn_InitInputType @@ -117,6 +118,11 @@ MODULE HydroDyn_Types 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 ======= @@ -485,15 +491,27 @@ SUBROUTINE HydroDyn_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt END SUBROUTINE HydroDyn_CopyInputFile - SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HydroDyn_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInputFile' + LOGICAL,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 @@ -506,9 +524,12 @@ SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) IF (ALLOCATED(InputFileData%AddBQuad)) THEN DEALLOCATE(InputFileData%AddBQuad) ENDIF - CALL Waves_DestroyInitInput( InputFileData%Waves, ErrStat, ErrMsg ) - CALL Waves2_DestroyInitInput( InputFileData%Waves2, ErrStat, ErrMsg ) - CALL Current_DestroyInitInput( InputFileData%Current, ErrStat, ErrMsg ) + 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 @@ -536,9 +557,12 @@ SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) IF (ALLOCATED(InputFileData%PtfmCOByt)) THEN DEALLOCATE(InputFileData%PtfmCOByt) ENDIF - CALL WAMIT_DestroyInitInput( InputFileData%WAMIT, ErrStat, ErrMsg ) - CALL WAMIT2_DestroyInitInput( InputFileData%WAMIT2, ErrStat, ErrMsg ) - CALL Morison_DestroyInitInput( InputFileData%Morison, ErrStat, ErrMsg ) + 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 @@ -1936,20 +1960,34 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, END IF DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY ENDIF + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY END SUBROUTINE HydroDyn_CopyInitInput - SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HydroDyn_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInitInput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedFileData, ErrStat, 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 @@ -2023,6 +2061,7 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 IF ( Re_BufSz .GT. 0 ) THEN @@ -2124,6 +2163,8 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 @@ -2245,6 +2286,8 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta 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) @@ -2261,6 +2304,7 @@ SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCo 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' @@ -2408,32 +2452,120 @@ SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCo 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 ) + SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HydroDyn_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInitOutput' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL Morison_DestroyInitOutput( InitOutputData%Morison, ErrStat, ErrMsg ) + 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 @@ -2443,7 +2575,8 @@ SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitOutputData%WaveElevSeries)) THEN DEALLOCATE(InitOutputData%WaveElevSeries) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) + 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 @@ -2458,6 +2591,21 @@ SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) 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 @@ -2637,6 +2785,31 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 @@ -2971,6 +3144,111 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 ) @@ -2988,6 +3266,7 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt 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' @@ -3398,6 +3677,126 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt 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 ) @@ -3425,18 +3824,33 @@ SUBROUTINE HydroDyn_CopyHD_ModuleMapType( SrcHD_ModuleMapTypeData, DstHD_ModuleM IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyHD_ModuleMapType - SUBROUTINE HydroDyn_DestroyHD_ModuleMapType( HD_ModuleMapTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyHD_ModuleMapType' + LOGICAL,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 = "" - CALL NWTC_Library_Destroymeshmaptype( HD_ModuleMapTypeData%uW_P_2_PRP_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( HD_ModuleMapTypeData%W_P_2_PRP_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( HD_ModuleMapTypeData%M_P_2_PRP_P, ErrStat, 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 ) @@ -3842,29 +4256,45 @@ SUBROUTINE HydroDyn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyContState - SUBROUTINE HydroDyn_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE HydroDyn_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HydroDyn_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyContState' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL Morison_DestroyContState( ContStateData%Morison, ErrStat, ErrMsg ) + 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 ) @@ -4426,29 +4856,45 @@ SUBROUTINE HydroDyn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyDiscState - SUBROUTINE HydroDyn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE HydroDyn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HydroDyn_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyDiscState' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL Morison_DestroyDiscState( DiscStateData%Morison, ErrStat, ErrMsg ) + 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 ) @@ -4983,19 +5429,35 @@ SUBROUTINE HydroDyn_CopyConstrState( SrcConstrStateData, DstConstrStateData, Ctr IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyConstrState - SUBROUTINE HydroDyn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE HydroDyn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HydroDyn_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyConstrState' + LOGICAL,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 = "" - CALL WAMIT_DestroyConstrState( ConstrStateData%WAMIT, ErrStat, ErrMsg ) - CALL WAMIT2_DestroyConstrState( ConstrStateData%WAMIT2, ErrStat, ErrMsg ) - CALL Waves2_DestroyConstrState( ConstrStateData%Waves2, ErrStat, ErrMsg ) - CALL Morison_DestroyConstrState( ConstrStateData%Morison, ErrStat, 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 ) @@ -5486,29 +5948,45 @@ SUBROUTINE HydroDyn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCo IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyOtherState - SUBROUTINE HydroDyn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE HydroDyn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HydroDyn_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyOtherState' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL Morison_DestroyOtherState( OtherStateData%Morison, ErrStat, ErrMsg ) + 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 ) @@ -6142,18 +6620,33 @@ SUBROUTINE HydroDyn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMs IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyMisc - SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyMisc' + LOGICAL,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 = "" - CALL MeshDestroy( MiscData%AllHdroOrigin, ErrStat, ErrMsg ) - CALL MeshDestroy( MiscData%MrsnMesh_position, ErrStat, ErrMsg ) - CALL HydroDyn_Destroyhd_modulemaptype( MiscData%HD_MeshMap, ErrStat, 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 @@ -6162,31 +6655,38 @@ SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(MiscData%WAMIT)) THEN DO i1 = LBOUND(MiscData%WAMIT,1), UBOUND(MiscData%WAMIT,1) - CALL WAMIT_DestroyMisc( MiscData%WAMIT(i1), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL Morison_DestroyMisc( MiscData%Morison, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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 ) @@ -7624,29 +8124,45 @@ SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Er DstParamData%Jac_ny = SrcParamData%Jac_ny END SUBROUTINE HydroDyn_CopyParam - SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HydroDyn_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyParam' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL Morison_DestroyParam( ParamData%Morison, ErrStat, ErrMsg ) + 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 @@ -7673,7 +8189,8 @@ SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -8989,18 +9506,33 @@ SUBROUTINE HydroDyn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyInput - SUBROUTINE HydroDyn_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE HydroDyn_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HydroDyn_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInput' + LOGICAL,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 = "" - CALL Morison_DestroyInput( InputData%Morison, ErrStat, ErrMsg ) - CALL MeshDestroy( InputData%WAMITMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( InputData%PRPMesh, ErrStat, 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 ) @@ -9421,30 +9953,47 @@ SUBROUTINE HydroDyn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ENDIF END SUBROUTINE HydroDyn_CopyOutput - SUBROUTINE HydroDyn_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE HydroDyn_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(HydroDyn_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyOutput' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL Morison_DestroyOutput( OutputData%Morison, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%WAMITMesh, ErrStat, ErrMsg ) + 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 diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 36419d3ee3..0d834adfa5 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2110,6 +2110,8 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In END IF END DO !J = 1, InitInp%InpJoints(I)%NConnections + + Vn = Vn*TwoPi/3.0_ReKi ! Semisphere volume is Vn = 2/3 pi \sum (r_MG^3 k) p%An_End(:,i) = An_drag Amag_drag = Dot_Product(An_drag ,An_drag) @@ -2127,7 +2129,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(transpose(v2D), v2D) + p%AM_End(:,:,i) = (InitInp%Nodes(I)%JAxCa*InitInp%WtrDens/ Vmag)*matmul(v2D, transpose(v2D)) end if ! Constant part of the external hydrodynamic dynamic pressure force @@ -2245,9 +2247,11 @@ FUNCTION GetAlpha(R1,R2) 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 - - GetAlpha = (R1*R1 + 2.0*R1*R2 + 3.0*R2*R2)/4.0/(R1*R1 + R1*R2 + R2*R2) - + if ( EqualRealNos(R1, 0.0_ReKi) .AND. EqualRealNos(R2, 0.0_ReKi) ) then ! if undefined, return 0 + GetAlpha = 0.0_ReKi + else + GetAlpha = (R1*R1 + 2.0*R1*R2 + 3.0*R2*R2)/4.0/(R1*R1 + R1*R2 + R2*R2) + end if END FUNCTION GetAlpha diff --git a/modules/hydrodyn/src/Morison_Output.f90 b/modules/hydrodyn/src/Morison_Output.f90 index 8c8a2b2caf..4ec1db451a 100644 --- a/modules/hydrodyn/src/Morison_Output.f90 +++ b/modules/hydrodyn/src/Morison_Output.f90 @@ -36,12 +36,6 @@ MODULE Morison_Output ! (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. - - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - ! Indices for computing output channels: ! NOTES: ! (1) These parameters are in the order stored in "OutListParameters.xlsx" @@ -9016,36 +9010,9 @@ FUNCTION GetMorisonChannels ( NUserOutputs, UserOutputs, OutList, foundMask 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 + Indx = FindValidChannelIndx(UserOutputs(I), ValidParamAry) + + IF ( Indx > 0 ) THEN newFoundMask(I) = .TRUE. foundMask(I) = .TRUE. GetMorisonChannels = GetMorisonChannels + 1 diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 09060ae3ff..8f1ca39fd1 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -440,15 +440,27 @@ SUBROUTINE Morison_CopyJointType( SrcJointTypeData, DstJointTypeData, CtrlCode, DstJointTypeData%ConnectionList = SrcJointTypeData%ConnectionList END SUBROUTINE Morison_CopyJointType - SUBROUTINE Morison_DestroyJointType( JointTypeData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyJointType( JointTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_JointType), INTENT(INOUT) :: JointTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyJointType' + LOGICAL,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 ) @@ -612,15 +624,27 @@ SUBROUTINE Morison_CopyMemberPropType( SrcMemberPropTypeData, DstMemberPropTypeD DstMemberPropTypeData%PropThck = SrcMemberPropTypeData%PropThck END SUBROUTINE Morison_CopyMemberPropType - SUBROUTINE Morison_DestroyMemberPropType( MemberPropTypeData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyMemberPropType( MemberPropTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_MemberPropType), INTENT(INOUT) :: MemberPropTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberPropType' + LOGICAL,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 ) @@ -763,15 +787,27 @@ SUBROUTINE Morison_CopyFilledGroupType( SrcFilledGroupTypeData, DstFilledGroupTy DstFilledGroupTypeData%FillDens = SrcFilledGroupTypeData%FillDens END SUBROUTINE Morison_CopyFilledGroupType - SUBROUTINE Morison_DestroyFilledGroupType( FilledGroupTypeData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyFilledGroupType( FilledGroupTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_FilledGroupType), INTENT(INOUT) :: FilledGroupTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyFilledGroupType' + LOGICAL,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 @@ -961,15 +997,27 @@ SUBROUTINE Morison_CopyCoefDpths( SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, DstCoefDpthsData%DpthAxCpMG = SrcCoefDpthsData%DpthAxCpMG END SUBROUTINE Morison_CopyCoefDpths - SUBROUTINE Morison_DestroyCoefDpths( CoefDpthsData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyCoefDpths( CoefDpthsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_CoefDpths), INTENT(INOUT) :: CoefDpthsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyCoefDpths' + LOGICAL,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 ) @@ -1149,15 +1197,27 @@ SUBROUTINE Morison_CopyAxialCoefType( SrcAxialCoefTypeData, DstAxialCoefTypeData DstAxialCoefTypeData%AxCp = SrcAxialCoefTypeData%AxCp END SUBROUTINE Morison_CopyAxialCoefType - SUBROUTINE Morison_DestroyAxialCoefType( AxialCoefTypeData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyAxialCoefType( AxialCoefTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_AxialCoefType), INTENT(INOUT) :: AxialCoefTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyAxialCoefType' + LOGICAL,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 ) @@ -1318,15 +1378,27 @@ SUBROUTINE Morison_CopyMemberInputType( SrcMemberInputTypeData, DstMemberInputTy DstMemberInputTypeData%dl = SrcMemberInputTypeData%dl END SUBROUTINE Morison_CopyMemberInputType - SUBROUTINE Morison_DestroyMemberInputType( MemberInputTypeData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyMemberInputType( MemberInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_MemberInputType), INTENT(INOUT) :: MemberInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberInputType' + LOGICAL,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 @@ -1577,15 +1649,27 @@ SUBROUTINE Morison_CopyNodeType( SrcNodeTypeData, DstNodeTypeData, CtrlCode, Err DstNodeTypeData%MGdensity = SrcNodeTypeData%MGdensity END SUBROUTINE Morison_CopyNodeType - SUBROUTINE Morison_DestroyNodeType( NodeTypeData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyNodeType( NodeTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_NodeType), INTENT(INOUT) :: NodeTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyNodeType' + LOGICAL,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 ) @@ -2243,15 +2327,27 @@ SUBROUTINE Morison_CopyMemberType( SrcMemberTypeData, DstMemberTypeData, CtrlCod DstMemberTypeData%Flipped = SrcMemberTypeData%Flipped END SUBROUTINE Morison_CopyMemberType - SUBROUTINE Morison_DestroyMemberType( MemberTypeData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyMemberType( MemberTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_MemberType), INTENT(INOUT) :: MemberTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberType' + LOGICAL,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 @@ -4207,15 +4303,27 @@ SUBROUTINE Morison_CopyMemberLoads( SrcMemberLoadsData, DstMemberLoadsData, Ctrl ENDIF END SUBROUTINE Morison_CopyMemberLoads - SUBROUTINE Morison_DestroyMemberLoads( MemberLoadsData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyMemberLoads( MemberLoadsData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_MemberLoads), INTENT(INOUT) :: MemberLoadsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberLoads' + LOGICAL,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 @@ -4914,15 +5022,27 @@ SUBROUTINE Morison_CopyCoefMembers( SrcCoefMembersData, DstCoefMembersData, Ctrl DstCoefMembersData%MemberAxCpMG2 = SrcCoefMembersData%MemberAxCpMG2 END SUBROUTINE Morison_CopyCoefMembers - SUBROUTINE Morison_DestroyCoefMembers( CoefMembersData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyCoefMembers( CoefMembersData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_CoefMembers), INTENT(INOUT) :: CoefMembersData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyCoefMembers' + LOGICAL,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 ) @@ -5161,15 +5281,27 @@ SUBROUTINE Morison_CopyMGDepthsType( SrcMGDepthsTypeData, DstMGDepthsTypeData, C DstMGDepthsTypeData%MGDens = SrcMGDepthsTypeData%MGDens END SUBROUTINE Morison_CopyMGDepthsType - SUBROUTINE Morison_DestroyMGDepthsType( MGDepthsTypeData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyMGDepthsType( MGDepthsTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_MGDepthsType), INTENT(INOUT) :: MGDepthsTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMGDepthsType' + LOGICAL,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 ) @@ -5371,15 +5503,27 @@ SUBROUTINE Morison_CopyMOutput( SrcMOutputData, DstMOutputData, CtrlCode, ErrSta ENDIF END SUBROUTINE Morison_CopyMOutput - SUBROUTINE Morison_DestroyMOutput( MOutputData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyMOutput( MOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_MOutput), INTENT(INOUT) :: MOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMOutput' + LOGICAL,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 @@ -5754,15 +5898,27 @@ SUBROUTINE Morison_CopyJOutput( SrcJOutputData, DstJOutputData, CtrlCode, ErrSta DstJOutputData%JointIDIndx = SrcJOutputData%JointIDIndx END SUBROUTINE Morison_CopyJOutput - SUBROUTINE Morison_DestroyJOutput( JOutputData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyJOutput( JOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_JOutput), INTENT(INOUT) :: JOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyJOutput' + LOGICAL,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 ) @@ -6183,78 +6339,101 @@ SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ENDIF END SUBROUTINE Morison_CopyInitInput - SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInitInput' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL Morison_Destroyjoutput( InitInputData%JOutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%JOutLst) ENDIF @@ -8222,15 +8401,27 @@ SUBROUTINE Morison_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCod ENDIF END SUBROUTINE Morison_CopyInitOutput - SUBROUTINE Morison_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInitOutput' + LOGICAL,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%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF @@ -8433,15 +8624,27 @@ SUBROUTINE Morison_CopyContState( SrcContStateData, DstContStateData, CtrlCode, DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE Morison_CopyContState - SUBROUTINE Morison_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyContState' + LOGICAL,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 ) @@ -8558,15 +8761,27 @@ SUBROUTINE Morison_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE Morison_CopyDiscState - SUBROUTINE Morison_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyDiscState' + LOGICAL,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 ) @@ -8683,15 +8898,27 @@ SUBROUTINE Morison_CopyConstrState( SrcConstrStateData, DstConstrStateData, Ctrl DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE Morison_CopyConstrState - SUBROUTINE Morison_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyConstrState' + LOGICAL,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 ) @@ -8808,15 +9035,27 @@ SUBROUTINE Morison_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCod DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE Morison_CopyOtherState - SUBROUTINE Morison_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyOtherState' + LOGICAL,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 ) @@ -9101,15 +9340,27 @@ SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%LastIndWave = SrcMiscData%LastIndWave END SUBROUTINE Morison_CopyMisc - SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMisc' + LOGICAL,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 @@ -9127,7 +9378,8 @@ SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(MiscData%memberLoads)) THEN DO i1 = LBOUND(MiscData%memberLoads,1), UBOUND(MiscData%memberLoads,1) - CALL Morison_Destroymemberloads( MiscData%memberLoads(i1), ErrStat, ErrMsg ) + CALL Morison_Destroymemberloads( MiscData%memberLoads(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%memberLoads) ENDIF @@ -10150,18 +10402,31 @@ SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%Delim = SrcParamData%Delim END SUBROUTINE Morison_CopyParam - SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyParam' + LOGICAL,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), ErrStat, ErrMsg ) + CALL Morison_Destroymembertype( ParamData%Members(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%Members) ENDIF @@ -10203,19 +10468,22 @@ SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%MOutLst)) THEN DO i1 = LBOUND(ParamData%MOutLst,1), UBOUND(ParamData%MOutLst,1) - CALL Morison_Destroymoutput( ParamData%MOutLst(i1), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -11504,16 +11772,29 @@ SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Morison_CopyInput - SUBROUTINE Morison_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInput' + LOGICAL,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 = "" - CALL MeshDestroy( InputData%Mesh, ErrStat, 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 ) @@ -11726,16 +12007,29 @@ SUBROUTINE Morison_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ENDIF END SUBROUTINE Morison_CopyOutput - SUBROUTINE Morison_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE Morison_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Morison_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyOutput' + LOGICAL,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 = "" - CALL MeshDestroy( OutputData%Mesh, ErrStat, 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) IF (ALLOCATED(OutputData%WriteOutput)) THEN DEALLOCATE(OutputData%WriteOutput) ENDIF diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 1dbef8c916..df75e5077f 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -161,15 +161,27 @@ SUBROUTINE SS_Exc_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E ENDIF END SUBROUTINE SS_Exc_CopyInitInput - SUBROUTINE SS_Exc_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE SS_Exc_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Exc_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInitInput' + LOGICAL,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 @@ -454,15 +466,27 @@ SUBROUTINE SS_Exc_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode ENDIF END SUBROUTINE SS_Exc_CopyInitOutput - SUBROUTINE SS_Exc_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE SS_Exc_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Exc_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInitOutput' + LOGICAL,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 @@ -677,15 +701,27 @@ SUBROUTINE SS_Exc_CopyContState( SrcContStateData, DstContStateData, CtrlCode, E ENDIF END SUBROUTINE SS_Exc_CopyContState - SUBROUTINE SS_Exc_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE SS_Exc_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyContState' + LOGICAL,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 @@ -839,15 +875,27 @@ SUBROUTINE SS_Exc_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, E DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE SS_Exc_CopyDiscState - SUBROUTINE SS_Exc_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE SS_Exc_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyDiscState' + LOGICAL,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 ) @@ -964,15 +1012,27 @@ SUBROUTINE SS_Exc_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlC DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE SS_Exc_CopyConstrState - SUBROUTINE SS_Exc_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE SS_Exc_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyConstrState' + LOGICAL,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 ) @@ -1095,17 +1155,30 @@ SUBROUTINE SS_Exc_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode ENDDO END SUBROUTINE SS_Exc_CopyOtherState - SUBROUTINE SS_Exc_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE SS_Exc_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyOtherState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL SS_Exc_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO END SUBROUTINE SS_Exc_DestroyOtherState @@ -1318,15 +1391,27 @@ SUBROUTINE SS_Exc_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%LastIndWave = SrcMiscData%LastIndWave END SUBROUTINE SS_Exc_CopyMisc - SUBROUTINE SS_Exc_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE SS_Exc_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyMisc' + LOGICAL,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 ) @@ -1514,15 +1599,27 @@ SUBROUTINE SS_Exc_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM ENDIF END SUBROUTINE SS_Exc_CopyParam - SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Exc_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyParam' + LOGICAL,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 @@ -1897,15 +1994,27 @@ SUBROUTINE SS_Exc_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%DummyInput = SrcInputData%DummyInput END SUBROUTINE SS_Exc_CopyInput - SUBROUTINE SS_Exc_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE SS_Exc_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Exc_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInput' + LOGICAL,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 ) @@ -2046,15 +2155,27 @@ SUBROUTINE SS_Exc_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, E ENDIF END SUBROUTINE SS_Exc_CopyOutput - SUBROUTINE SS_Exc_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE SS_Exc_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Exc_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyOutput' + LOGICAL,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 diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 9b26c59a72..dcea3022a3 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -140,15 +140,27 @@ SUBROUTINE SS_Rad_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E ENDIF END SUBROUTINE SS_Rad_CopyInitInput - SUBROUTINE SS_Rad_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE SS_Rad_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Rad_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInitInput' + LOGICAL,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 @@ -382,15 +394,27 @@ SUBROUTINE SS_Rad_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode ENDIF END SUBROUTINE SS_Rad_CopyInitOutput - SUBROUTINE SS_Rad_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE SS_Rad_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Rad_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInitOutput' + LOGICAL,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 @@ -605,15 +629,27 @@ SUBROUTINE SS_Rad_CopyContState( SrcContStateData, DstContStateData, CtrlCode, E ENDIF END SUBROUTINE SS_Rad_CopyContState - SUBROUTINE SS_Rad_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE SS_Rad_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Rad_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyContState' + LOGICAL,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 @@ -767,15 +803,27 @@ SUBROUTINE SS_Rad_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, E DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE SS_Rad_CopyDiscState - SUBROUTINE SS_Rad_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE SS_Rad_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Rad_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyDiscState' + LOGICAL,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 ) @@ -892,15 +940,27 @@ SUBROUTINE SS_Rad_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlC DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE SS_Rad_CopyConstrState - SUBROUTINE SS_Rad_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE SS_Rad_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Rad_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyConstrState' + LOGICAL,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 ) @@ -1023,17 +1083,30 @@ SUBROUTINE SS_Rad_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode ENDDO END SUBROUTINE SS_Rad_CopyOtherState - SUBROUTINE SS_Rad_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE SS_Rad_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Rad_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyOtherState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL SS_Rad_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO END SUBROUTINE SS_Rad_DestroyOtherState @@ -1246,15 +1319,27 @@ SUBROUTINE SS_Rad_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE SS_Rad_CopyMisc - SUBROUTINE SS_Rad_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE SS_Rad_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Rad_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyMisc' + LOGICAL,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 ) @@ -1429,15 +1514,27 @@ SUBROUTINE SS_Rad_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%NBody = SrcParamData%NBody END SUBROUTINE SS_Rad_CopyParam - SUBROUTINE SS_Rad_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE SS_Rad_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Rad_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyParam' + LOGICAL,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 @@ -1772,15 +1869,27 @@ SUBROUTINE SS_Rad_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM ENDIF END SUBROUTINE SS_Rad_CopyInput - SUBROUTINE SS_Rad_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE SS_Rad_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Rad_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInput' + LOGICAL,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 @@ -1958,15 +2067,27 @@ SUBROUTINE SS_Rad_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, E ENDIF END SUBROUTINE SS_Rad_CopyOutput - SUBROUTINE SS_Rad_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE SS_Rad_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SS_Rad_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyOutput' + LOGICAL,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 diff --git a/modules/hydrodyn/src/UserWaves.f90 b/modules/hydrodyn/src/UserWaves.f90 index a979b5df93..4689ba2438 100644 --- a/modules/hydrodyn/src/UserWaves.f90 +++ b/modules/hydrodyn/src/UserWaves.f90 @@ -944,7 +944,7 @@ FUNCTION ExtractFields(FU, s, n) result(OK) CHARACTER(*), INTENT(OUT) :: s(n) !< Fields LOGICAL :: OK ! Local var - CHARACTER(2048) :: TextLine !< One line of text read from the file + CHARACTER(65536) :: TextLine !< One line of text read from the file OK=.TRUE. ! Read line diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index fad0873cea..080f7eb5a3 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -816,14 +816,14 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! Local Variables CHARACTER(2048) :: ErrMsgTmp !< Temporary error message for calls INTEGER(IntKi) :: ErrStatTmp !< Temporary error status for calls - REAL(SiKi) :: TmpReal1 !< Temporary real - REAL(SiKi) :: TmpReal2 !< Temporary real +! REAL(SiKi) :: TmpReal1 !< Temporary real +! REAL(SiKi) :: TmpReal2 !< Temporary real LOGICAL :: TmpFlag !< Temporary logical flag INTEGER(IntKi) :: ThisDim !< Generic counter for dimension INTEGER(IntKi) :: IBody !< Index to which body we are on INTEGER(IntKi) :: Idx !< Index to the full set of 6*NBody INTEGER(IntKi) :: J !< Generic counter - INTEGER(IntKi) :: K !< Generic counter +! INTEGER(IntKi) :: K !< Generic counter CHARACTER(*), PARAMETER :: RoutineName = 'MnDrift_InitCalc' @@ -1337,13 +1337,13 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg CHARACTER(2048) :: ErrMsgTmp !< Temporary error message for calls INTEGER(IntKi) :: ErrStatTmp !< Temporary error status for calls REAL(SiKi) :: TmpReal1 !< Temporary real - REAL(SiKi) :: TmpReal2 !< Temporary real +! REAL(SiKi) :: TmpReal2 !< Temporary real LOGICAL :: TmpFlag !< Temporary logical flag INTEGER(IntKi) :: ThisDim !< Generic counter for dimension INTEGER(IntKi) :: IBody !< Index to which body we are on INTEGER(IntKi) :: Idx !< Index to the full set of 6*NBody INTEGER(IntKi) :: J !< Generic counter - INTEGER(IntKi) :: K !< Generic counter +! INTEGER(IntKi) :: K !< Generic counter TYPE(FFT_DataType) :: FFT_Data !< Temporary array for the FFT module we're using CHARACTER(*), PARAMETER :: RoutineName = 'NewmanApp_InitCalc' @@ -3091,7 +3091,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(2048) :: ErrMsgTmp !< Temporary error message variable CHARACTER(*), PARAMETER :: RoutineName = 'CheckInitInput' !> ## Subroutine contents @@ -5266,7 +5266,7 @@ SUBROUTINE UniqueRealValues( DataArrayIn, DataArrayOut, NumUnique, ErrStat, ErrM CHARACTER(*), INTENT( OUT) :: ErrMsg !< Message about the error ! Local variables - REAL(SiKi) :: TmpReal !< Temporary real value +! REAL(SiKi) :: TmpReal !< Temporary real value INTEGER(IntKi) :: I !< Generic counter INTEGER(IntKi) :: J !< Generic counter REAL(SiKi), ALLOCATABLE :: TmpRealArray(:) !< Temporary real array @@ -5406,7 +5406,7 @@ SUBROUTINE GetFileLength(UnitDataFile, Filename, NumDataColumns, NumDataLines, N 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. + 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) :: 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. @@ -5462,13 +5462,7 @@ SUBROUTINE GetFileLength(UnitDataFile, Filename, NumDataColumns, NumDataLines, N !> 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 + CALL GetWords( TextLine, Words, size(Words), NumWords ) !> Now cycle through the first 'NumWords' of non-empty values stored in 'Words'. Words should contain diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 27627976a3..972f4ce915 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -280,15 +280,27 @@ SUBROUTINE WAMIT2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS END SUBROUTINE WAMIT2_CopyInitInput - SUBROUTINE WAMIT2_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT2_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT2_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyInitInput' + LOGICAL,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 @@ -863,15 +875,27 @@ SUBROUTINE WAMIT2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%NULLVAL = SrcInitOutputData%NULLVAL END SUBROUTINE WAMIT2_CopyInitOutput - SUBROUTINE WAMIT2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT2_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyInitOutput' + LOGICAL,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 ) @@ -988,15 +1012,27 @@ SUBROUTINE WAMIT2_CopyContState( SrcContStateData, DstContStateData, CtrlCode, E DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE WAMIT2_CopyContState - SUBROUTINE WAMIT2_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT2_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT2_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyContState' + LOGICAL,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 ) @@ -1113,15 +1149,27 @@ SUBROUTINE WAMIT2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, E DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE WAMIT2_CopyDiscState - SUBROUTINE WAMIT2_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT2_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT2_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyDiscState' + LOGICAL,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 ) @@ -1238,15 +1286,27 @@ SUBROUTINE WAMIT2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlC DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE WAMIT2_CopyConstrState - SUBROUTINE WAMIT2_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT2_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT2_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyConstrState' + LOGICAL,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 ) @@ -1363,15 +1423,27 @@ SUBROUTINE WAMIT2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE WAMIT2_CopyOtherState - SUBROUTINE WAMIT2_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT2_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT2_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyOtherState' + LOGICAL,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 ) @@ -1501,15 +1573,27 @@ SUBROUTINE WAMIT2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%F_Waves2 = SrcMiscData%F_Waves2 END SUBROUTINE WAMIT2_CopyMisc - SUBROUTINE WAMIT2_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT2_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT2_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyMisc' + LOGICAL,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 @@ -1735,15 +1819,27 @@ SUBROUTINE WAMIT2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%UnOutFile = SrcParamData%UnOutFile END SUBROUTINE WAMIT2_CopyParam - SUBROUTINE WAMIT2_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT2_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT2_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyParam' + LOGICAL,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 @@ -1752,7 +1848,8 @@ SUBROUTINE WAMIT2_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -2204,16 +2301,29 @@ SUBROUTINE WAMIT2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT2_CopyInput - SUBROUTINE WAMIT2_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT2_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT2_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyInput' + LOGICAL,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 = "" - CALL MeshDestroy( InputData%Mesh, ErrStat, 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 ) @@ -2413,16 +2523,29 @@ SUBROUTINE WAMIT2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT2_CopyOutput - SUBROUTINE WAMIT2_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT2_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT2_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyOutput' + LOGICAL,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 = "" - CALL MeshDestroy( OutputData%Mesh, ErrStat, 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 ) diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index d5f86e17dd..4cdcbb6a88 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -339,15 +339,27 @@ SUBROUTINE WAMIT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NumOuts = SrcInitInputData%NumOuts END SUBROUTINE WAMIT_CopyInitInput - SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyInitInput' + LOGICAL,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 @@ -369,7 +381,8 @@ SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitInputData%PtfmCOByt)) THEN DEALLOCATE(InitInputData%PtfmCOByt) ENDIF - CALL Conv_Rdtn_DestroyInitInput( InitInputData%Conv_Rdtn, ErrStat, ErrMsg ) + 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 @@ -1133,15 +1146,27 @@ SUBROUTINE WAMIT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%NULLVAL = SrcInitOutputData%NULLVAL END SUBROUTINE WAMIT_CopyInitOutput - SUBROUTINE WAMIT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyInitOutput' + LOGICAL,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 ) @@ -1266,18 +1291,33 @@ SUBROUTINE WAMIT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyContState - SUBROUTINE WAMIT_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyContState' + LOGICAL,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 = "" - CALL SS_Rad_DestroyContState( ContStateData%SS_Rdtn, ErrStat, ErrMsg ) - CALL SS_Exc_DestroyContState( ContStateData%SS_Exctn, ErrStat, ErrMsg ) - CALL Conv_Rdtn_DestroyContState( ContStateData%Conv_Rdtn, ErrStat, 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 ) @@ -1653,18 +1693,33 @@ SUBROUTINE WAMIT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyDiscState - SUBROUTINE WAMIT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyDiscState' + LOGICAL,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 = "" - CALL Conv_Rdtn_DestroyDiscState( DiscStateData%Conv_Rdtn, ErrStat, ErrMsg ) - CALL SS_Rad_DestroyDiscState( DiscStateData%SS_Rdtn, ErrStat, ErrMsg ) - CALL SS_Exc_DestroyDiscState( DiscStateData%SS_Exctn, ErrStat, 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 ) @@ -2040,18 +2095,33 @@ SUBROUTINE WAMIT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCo IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyConstrState - SUBROUTINE WAMIT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyConstrState' + LOGICAL,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 = "" - CALL Conv_Rdtn_DestroyConstrState( ConstrStateData%Conv_Rdtn, ErrStat, ErrMsg ) - CALL SS_Rad_DestroyConstrState( ConstrStateData%SS_Rdtn, ErrStat, ErrMsg ) - CALL SS_Exc_DestroyConstrState( ConstrStateData%SS_Exctn, ErrStat, 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 ) @@ -2427,18 +2497,33 @@ SUBROUTINE WAMIT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyOtherState - SUBROUTINE WAMIT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyOtherState' + LOGICAL,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 = "" - CALL SS_Rad_DestroyOtherState( OtherStateData%SS_Rdtn, ErrStat, ErrMsg ) - CALL SS_Exc_DestroyOtherState( OtherStateData%SS_Exctn, ErrStat, ErrMsg ) - CALL Conv_Rdtn_DestroyOtherState( OtherStateData%Conv_Rdtn, ErrStat, 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 ) @@ -2882,15 +2967,27 @@ SUBROUTINE WAMIT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyMisc - SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyMisc' + LOGICAL,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 @@ -2903,15 +3000,24 @@ SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%F_PtfmAM)) THEN DEALLOCATE(MiscData%F_PtfmAM) ENDIF - CALL SS_Rad_DestroyMisc( MiscData%SS_Rdtn, ErrStat, ErrMsg ) - CALL SS_Rad_DestroyInput( MiscData%SS_Rdtn_u, ErrStat, ErrMsg ) - CALL SS_Rad_DestroyOutput( MiscData%SS_Rdtn_y, ErrStat, ErrMsg ) - CALL SS_Exc_DestroyMisc( MiscData%SS_Exctn, ErrStat, ErrMsg ) - CALL SS_Exc_DestroyInput( MiscData%SS_Exctn_u, ErrStat, ErrMsg ) - CALL SS_Exc_DestroyOutput( MiscData%SS_Exctn_y, ErrStat, ErrMsg ) - CALL Conv_Rdtn_DestroyMisc( MiscData%Conv_Rdtn, ErrStat, ErrMsg ) - CALL Conv_Rdtn_DestroyInput( MiscData%Conv_Rdtn_u, ErrStat, ErrMsg ) - CALL Conv_Rdtn_DestroyOutput( MiscData%Conv_Rdtn_y, ErrStat, ErrMsg ) + 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 ) @@ -4041,15 +4147,27 @@ SUBROUTINE WAMIT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%UnOutFile = SrcParamData%UnOutFile END SUBROUTINE WAMIT_CopyParam - SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyParam' + LOGICAL,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 @@ -4062,12 +4180,16 @@ SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%WaveExctn)) THEN DEALLOCATE(ParamData%WaveExctn) ENDIF - CALL Conv_Rdtn_DestroyParam( ParamData%Conv_Rdtn, ErrStat, ErrMsg ) - CALL SS_Rad_DestroyParam( ParamData%SS_Rdtn, ErrStat, ErrMsg ) - CALL SS_Exc_DestroyParam( ParamData%SS_Exctn, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -4826,16 +4948,29 @@ SUBROUTINE WAMIT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyInput - SUBROUTINE WAMIT_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyInput' + LOGICAL,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 = "" - CALL MeshDestroy( InputData%Mesh, ErrStat, 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 ) @@ -5035,16 +5170,29 @@ SUBROUTINE WAMIT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyOutput - SUBROUTINE WAMIT_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE WAMIT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WAMIT_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyOutput' + LOGICAL,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 = "" - CALL MeshDestroy( OutputData%Mesh, ErrStat, 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 ) diff --git a/modules/hydrodyn/src/Waves.f90 b/modules/hydrodyn/src/Waves.f90 index 5358c49a49..8934278e16 100644 --- a/modules/hydrodyn/src/Waves.f90 +++ b/modules/hydrodyn/src/Waves.f90 @@ -34,6 +34,21 @@ MODULE Waves 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 @@ -1670,6 +1685,35 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) 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 @@ -1781,6 +1825,28 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) 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 @@ -2182,8 +2248,13 @@ SUBROUTINE Waves_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init 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. diff --git a/modules/hydrodyn/src/Waves.txt b/modules/hydrodyn/src/Waves.txt index 366067469c..5469e8b88f 100644 --- a/modules/hydrodyn/src/Waves.txt +++ b/modules/hydrodyn/src/Waves.txt @@ -51,6 +51,9 @@ typedef ^ ^ INTEGER NWaveElev 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) @@ -82,6 +85,8 @@ typedef ^ ^ SiKi PWaveVel0 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) diff --git a/modules/hydrodyn/src/Waves2_Output.f90 b/modules/hydrodyn/src/Waves2_Output.f90 index 817ebc7272..0faee486ee 100644 --- a/modules/hydrodyn/src/Waves2_Output.f90 +++ b/modules/hydrodyn/src/Waves2_Output.f90 @@ -34,7 +34,6 @@ MODULE Waves2_Output ! (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 - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen ! Waves2 Body Forces: diff --git a/modules/hydrodyn/src/Waves2_Types.f90 b/modules/hydrodyn/src/Waves2_Types.f90 index affe3fdc41..c5c1afd7dc 100644 --- a/modules/hydrodyn/src/Waves2_Types.f90 +++ b/modules/hydrodyn/src/Waves2_Types.f90 @@ -294,15 +294,27 @@ SUBROUTINE Waves2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%NumOutAll = SrcInitInputData%NumOutAll END SUBROUTINE Waves2_CopyInitInput - SUBROUTINE Waves2_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE Waves2_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves2_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitInput' + LOGICAL,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 @@ -1145,15 +1157,27 @@ SUBROUTINE Waves2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode ENDIF END SUBROUTINE Waves2_CopyInitOutput - SUBROUTINE Waves2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE Waves2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves2_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitOutput' + LOGICAL,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 @@ -2101,15 +2125,27 @@ SUBROUTINE Waves2_CopyContState( SrcContStateData, DstContStateData, CtrlCode, E DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE Waves2_CopyContState - SUBROUTINE Waves2_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE Waves2_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves2_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyContState' + LOGICAL,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 ) @@ -2226,15 +2262,27 @@ SUBROUTINE Waves2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, E DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE Waves2_CopyDiscState - SUBROUTINE Waves2_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE Waves2_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves2_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyDiscState' + LOGICAL,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 ) @@ -2351,15 +2399,27 @@ SUBROUTINE Waves2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlC DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE Waves2_CopyConstrState - SUBROUTINE Waves2_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE Waves2_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves2_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyConstrState' + LOGICAL,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 ) @@ -2476,15 +2536,27 @@ SUBROUTINE Waves2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE Waves2_CopyOtherState - SUBROUTINE Waves2_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE Waves2_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves2_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyOtherState' + LOGICAL,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 ) @@ -2601,15 +2673,27 @@ SUBROUTINE Waves2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%LastIndWave = SrcMiscData%LastIndWave END SUBROUTINE Waves2_CopyMisc - SUBROUTINE Waves2_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE Waves2_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves2_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyMisc' + LOGICAL,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 ) @@ -2781,15 +2865,27 @@ SUBROUTINE Waves2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%UnOutFile = SrcParamData%UnOutFile END SUBROUTINE Waves2_CopyParam - SUBROUTINE Waves2_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE Waves2_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves2_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyParam' + LOGICAL,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 @@ -2798,7 +2894,8 @@ SUBROUTINE Waves2_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -3194,15 +3291,27 @@ SUBROUTINE Waves2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%DummyInput = SrcInputData%DummyInput END SUBROUTINE Waves2_CopyInput - SUBROUTINE Waves2_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE Waves2_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves2_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInput' + LOGICAL,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 ) @@ -3331,15 +3440,27 @@ SUBROUTINE Waves2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, E ENDIF END SUBROUTINE Waves2_CopyOutput - SUBROUTINE Waves2_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE Waves2_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves2_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyOutput' + LOGICAL,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 diff --git a/modules/hydrodyn/src/Waves_Types.f90 b/modules/hydrodyn/src/Waves_Types.f90 index 9b98fdc949..3c3a277d08 100644 --- a/modules/hydrodyn/src/Waves_Types.f90 +++ b/modules/hydrodyn/src/Waves_Types.f90 @@ -68,6 +68,9 @@ MODULE Waves_Types 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)] @@ -98,6 +101,7 @@ MODULE Waves_Types 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)] @@ -237,6 +241,9 @@ SUBROUTINE Waves_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er 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) @@ -305,15 +312,27 @@ SUBROUTINE Waves_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Waves_CopyInitInput - SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitInput' + LOGICAL,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 @@ -338,7 +357,8 @@ SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitInputData%CurrVyi)) THEN DEALLOCATE(InitInputData%CurrVyi) ENDIF - CALL NWTC_Library_Destroynwtc_randomnumber_parametertype( InitInputData%RNG, ErrStat, ErrMsg ) + 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 ) @@ -421,6 +441,9 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err 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 @@ -616,6 +639,12 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err 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 @@ -889,6 +918,12 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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 @@ -1206,6 +1241,20 @@ SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, 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) @@ -1252,15 +1301,27 @@ SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 END SUBROUTINE Waves_CopyInitOutput - SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitOutput' + LOGICAL,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 @@ -1294,6 +1355,9 @@ SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) 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 @@ -1401,6 +1465,11 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er 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 @@ -1684,6 +1753,26 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er 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 @@ -2048,6 +2137,29 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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 @@ -2139,15 +2251,27 @@ SUBROUTINE Waves_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Er DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE Waves_CopyContState - SUBROUTINE Waves_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE Waves_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyContState' + LOGICAL,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 ) @@ -2264,15 +2388,27 @@ SUBROUTINE Waves_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Er DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE Waves_CopyDiscState - SUBROUTINE Waves_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE Waves_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyDiscState' + LOGICAL,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 ) @@ -2389,15 +2525,27 @@ SUBROUTINE Waves_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCo DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE Waves_CopyConstrState - SUBROUTINE Waves_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE Waves_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyConstrState' + LOGICAL,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 ) @@ -2514,15 +2662,27 @@ SUBROUTINE Waves_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE Waves_CopyOtherState - SUBROUTINE Waves_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE Waves_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyOtherState' + LOGICAL,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 ) @@ -2639,15 +2799,27 @@ SUBROUTINE Waves_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE Waves_CopyMisc - SUBROUTINE Waves_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE Waves_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyMisc' + LOGICAL,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 ) @@ -2768,15 +2940,27 @@ SUBROUTINE Waves_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%WaveMultiDir = SrcParamData%WaveMultiDir END SUBROUTINE Waves_CopyParam - SUBROUTINE Waves_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE Waves_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyParam' + LOGICAL,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 ) @@ -2913,15 +3097,27 @@ SUBROUTINE Waves_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs DstInputData%DummyInput = SrcInputData%DummyInput END SUBROUTINE Waves_CopyInput - SUBROUTINE Waves_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE Waves_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInput' + LOGICAL,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 ) @@ -3038,15 +3234,27 @@ SUBROUTINE Waves_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er DstOutputData%DummyOutput = SrcOutputData%DummyOutput END SUBROUTINE Waves_CopyOutput - SUBROUTINE Waves_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE Waves_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Waves_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyOutput' + LOGICAL,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 ) diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 5a676fa8b3..f3c98e47c4 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -335,15 +335,27 @@ SUBROUTINE IceD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%FspN = SrcInputFileData%FspN END SUBROUTINE IceD_CopyInputFile - SUBROUTINE IceD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE IceD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceD_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInputFile' + LOGICAL,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 @@ -870,15 +882,27 @@ SUBROUTINE IceD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%TMax = SrcInitInputData%TMax END SUBROUTINE IceD_CopyInitInput - SUBROUTINE IceD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE IceD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInitInput' + LOGICAL,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 ) @@ -1061,22 +1085,35 @@ SUBROUTINE IceD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IceD_CopyInitOutput - SUBROUTINE IceD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE IceD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInitOutput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 ) @@ -1365,15 +1402,27 @@ SUBROUTINE IceD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err DstContStateData%dqdt = SrcContStateData%dqdt END SUBROUTINE IceD_CopyContState - SUBROUTINE IceD_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE IceD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyContState' + LOGICAL,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 ) @@ -1495,15 +1544,27 @@ SUBROUTINE IceD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE IceD_CopyDiscState - SUBROUTINE IceD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE IceD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyDiscState' + LOGICAL,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 ) @@ -1620,15 +1681,27 @@ SUBROUTINE IceD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE IceD_CopyConstrState - SUBROUTINE IceD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE IceD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyConstrState' + LOGICAL,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 ) @@ -1803,15 +1876,27 @@ SUBROUTINE IceD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%n = SrcOtherStateData%n END SUBROUTINE IceD_CopyOtherState - SUBROUTINE IceD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE IceD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyOtherState' + LOGICAL,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 @@ -1823,7 +1908,8 @@ SUBROUTINE IceD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(OtherStateData%xdot)) THEN DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL IceD_DestroyContState( OtherStateData%xdot(i1), ErrStat, ErrMsg ) + CALL IceD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%xdot) ENDIF @@ -2204,15 +2290,27 @@ SUBROUTINE IceD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE IceD_CopyMisc - SUBROUTINE IceD_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE IceD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyMisc' + LOGICAL,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 ) @@ -2497,15 +2595,27 @@ SUBROUTINE IceD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%Fsp = SrcParamData%Fsp END SUBROUTINE IceD_CopyParam - SUBROUTINE IceD_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE IceD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyParam' + LOGICAL,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 @@ -3282,16 +3392,29 @@ SUBROUTINE IceD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IceD_CopyInput - SUBROUTINE IceD_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE IceD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInput' + LOGICAL,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 = "" - CALL MeshDestroy( InputData%PointMesh, ErrStat, 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 ) @@ -3504,16 +3627,29 @@ SUBROUTINE IceD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE IceD_CopyOutput - SUBROUTINE IceD_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE IceD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyOutput' + LOGICAL,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 = "" - CALL MeshDestroy( OutputData%PointMesh, ErrStat, 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 diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 630cf872cc..1fea1d5380 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -132,15 +132,27 @@ SUBROUTINE IceFloe_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%RootName = SrcInitInputData%RootName END SUBROUTINE IceFloe_CopyInitInput - SUBROUTINE IceFloe_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE IceFloe_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceFloe_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInitInput' + LOGICAL,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 ) @@ -314,22 +326,35 @@ SUBROUTINE IceFloe_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IceFloe_CopyInitOutput - SUBROUTINE IceFloe_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE IceFloe_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceFloe_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInitOutput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 ) @@ -612,15 +637,27 @@ SUBROUTINE IceFloe_CopyContState( SrcContStateData, DstContStateData, CtrlCode, DstContStateData%DummyContStateVar = SrcContStateData%DummyContStateVar END SUBROUTINE IceFloe_CopyContState - SUBROUTINE IceFloe_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE IceFloe_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceFloe_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyContState' + LOGICAL,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 ) @@ -737,15 +774,27 @@ SUBROUTINE IceFloe_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, DstDiscStateData%DummyDiscStateVar = SrcDiscStateData%DummyDiscStateVar END SUBROUTINE IceFloe_CopyDiscState - SUBROUTINE IceFloe_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE IceFloe_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceFloe_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyDiscState' + LOGICAL,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 ) @@ -862,15 +911,27 @@ SUBROUTINE IceFloe_CopyConstrState( SrcConstrStateData, DstConstrStateData, Ctrl DstConstrStateData%DummyConstrStateVar = SrcConstrStateData%DummyConstrStateVar END SUBROUTINE IceFloe_CopyConstrState - SUBROUTINE IceFloe_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE IceFloe_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceFloe_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyConstrState' + LOGICAL,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 ) @@ -987,15 +1048,27 @@ SUBROUTINE IceFloe_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCod DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE IceFloe_CopyOtherState - SUBROUTINE IceFloe_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE IceFloe_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceFloe_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyOtherState' + LOGICAL,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 ) @@ -1112,15 +1185,27 @@ SUBROUTINE IceFloe_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE IceFloe_CopyMisc - SUBROUTINE IceFloe_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE IceFloe_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceFloe_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyMisc' + LOGICAL,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 ) @@ -1303,15 +1388,27 @@ SUBROUTINE IceFloe_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%initFlag = SrcParamData%initFlag END SUBROUTINE IceFloe_CopyParam - SUBROUTINE IceFloe_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE IceFloe_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceFloe_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyParam' + LOGICAL,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 @@ -1676,16 +1773,29 @@ SUBROUTINE IceFloe_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IceFloe_CopyInput - SUBROUTINE IceFloe_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE IceFloe_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceFloe_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInput' + LOGICAL,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 = "" - CALL MeshDestroy( InputData%iceMesh, ErrStat, 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 ) @@ -1898,16 +2008,29 @@ SUBROUTINE IceFloe_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ENDIF END SUBROUTINE IceFloe_CopyOutput - SUBROUTINE IceFloe_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE IceFloe_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IceFloe_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyOutput' + LOGICAL,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 = "" - CALL MeshDestroy( OutputData%iceMesh, ErrStat, 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 diff --git a/modules/inflowwind/python-lib/inflowwind_library.py b/modules/inflowwind/python-lib/inflowwind_library.py index 2a2d7e74ef..26e6eb599a 100644 --- a/modules/inflowwind/python-lib/inflowwind_library.py +++ b/modules/inflowwind/python-lib/inflowwind_library.py @@ -255,17 +255,19 @@ def __init__(self, filename, numWindPts): t_string=datetime.datetime.now() dt_string=datetime.date.today() self.debug_file.write(f"## This file was generated by InflowWind_Driver on {dt_string.strftime('%b-%d-%Y')} at {t_string.strftime('%H:%M:%S')}{os.linesep}") - self.debug_file.write(f"## This file contains the wind velocity at the {numWindPts} points specified in the file ") - self.debug_file.write(f"{filename}{os.linesep}") - self.debug_file.write(f"#{os.linesep}") - self.debug_file.write(f"# T X Y Z U V W{os.linesep}") - self.debug_file.write(f"# (s) (m) (m) (m) (m/s) (m/s) (m/s){os.linesep}") + self.debug_file.write(f"## This file contains the wind velocity at the {numWindPts} points specified in the file {filename}{os.linesep}") + self.debug_file.write(f"# {os.linesep}") + self.debug_file.write(f"# {os.linesep}") + self.debug_file.write(f"# {os.linesep}") + self.debug_file.write(f"# {os.linesep}") + self.debug_file.write(f" T X Y Z U V W{os.linesep}") + self.debug_file.write(f" (s) (m) (m) (m) (m/s) (m/s) (m/s){os.linesep}") self.opened = True def write(self,t,positions,velocities): for p, v in zip(positions,velocities): # TODO: does \n work as expected on Windows? - self.debug_file.write(' %14.7f %14.7f %14.7f %14.7f %14.7f %14.7f %14.7f\n' % (t,p[0],p[1],p[2],v[0],v[1],v[2])) + self.debug_file.write(' %16.8f %16.8f %16.8f %16.8f %16.8f %16.8f %16.8f\n' % (t,p[0],p[1],p[2],v[0],v[1],v[2])) def end(self): if self.opened: diff --git a/modules/inflowwind/src/IfW_4Dext_Types.f90 b/modules/inflowwind/src/IfW_4Dext_Types.f90 index b87a4e1fe4..a764d703ad 100644 --- a/modules/inflowwind/src/IfW_4Dext_Types.f90 +++ b/modules/inflowwind/src/IfW_4Dext_Types.f90 @@ -83,15 +83,27 @@ SUBROUTINE IfW_4Dext_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode DstInitInputData%pZero = SrcInitInputData%pZero END SUBROUTINE IfW_4Dext_CopyInitInput - SUBROUTINE IfW_4Dext_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_4Dext_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_4Dext_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_4Dext_DestroyInitInput' + LOGICAL,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_4Dext_DestroyInitInput' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_4Dext_DestroyInitInput SUBROUTINE IfW_4Dext_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -243,16 +255,29 @@ SUBROUTINE IfW_4Dext_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlC IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IfW_4Dext_CopyInitOutput - SUBROUTINE IfW_4Dext_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_4Dext_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_4Dext_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_4Dext_DestroyInitOutput' + LOGICAL,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_4Dext_DestroyInitOutput' + ErrStat = ErrID_None ErrMsg = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 IfW_4Dext_DestroyInitOutput SUBROUTINE IfW_4Dext_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -475,15 +500,27 @@ SUBROUTINE IfW_4Dext_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM DstMiscData%TgridStart = SrcMiscData%TgridStart END SUBROUTINE IfW_4Dext_CopyMisc - SUBROUTINE IfW_4Dext_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE IfW_4Dext_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_4Dext_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_4Dext_DestroyMisc' + LOGICAL,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_4Dext_DestroyMisc' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + IF (ALLOCATED(MiscData%V)) THEN DEALLOCATE(MiscData%V) ENDIF @@ -689,15 +726,27 @@ SUBROUTINE IfW_4Dext_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%pZero = SrcParamData%pZero END SUBROUTINE IfW_4Dext_CopyParam - SUBROUTINE IfW_4Dext_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE IfW_4Dext_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_4Dext_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_4Dext_DestroyParam' + LOGICAL,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_4Dext_DestroyParam' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_4Dext_DestroyParam SUBROUTINE IfW_4Dext_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) diff --git a/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 b/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 index 2b6c032c89..4f0ea3b994 100644 --- a/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 +++ b/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 @@ -86,15 +86,27 @@ SUBROUTINE IfW_BladedFFWind_CopyInitInput( SrcInitInputData, DstInitInputData, C DstInitInputData%FixedWindFileRootName = SrcInitInputData%FixedWindFileRootName END SUBROUTINE IfW_BladedFFWind_CopyInitInput - SUBROUTINE IfW_BladedFFWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_BladedFFWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_BladedFFWind_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_BladedFFWind_DestroyInitInput' + LOGICAL,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_BladedFFWind_DestroyInitInput' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_BladedFFWind_DestroyInitInput SUBROUTINE IfW_BladedFFWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -247,16 +259,29 @@ SUBROUTINE IfW_BladedFFWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData DstInitOutputData%VFlowAngle = SrcInitOutputData%VFlowAngle END SUBROUTINE IfW_BladedFFWind_CopyInitOutput - SUBROUTINE IfW_BladedFFWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_BladedFFWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_BladedFFWind_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_BladedFFWind_DestroyInitOutput' + LOGICAL,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_BladedFFWind_DestroyInitOutput' + ErrStat = ErrID_None ErrMsg = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 IfW_BladedFFWind_DestroyInitOutput SUBROUTINE IfW_BladedFFWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -476,15 +501,27 @@ SUBROUTINE IfW_BladedFFWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrSta DstMiscData%dummy = SrcMiscData%dummy END SUBROUTINE IfW_BladedFFWind_CopyMisc - SUBROUTINE IfW_BladedFFWind_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE IfW_BladedFFWind_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_BladedFFWind_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_BladedFFWind_DestroyMisc' + LOGICAL,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_BladedFFWind_DestroyMisc' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_BladedFFWind_DestroyMisc SUBROUTINE IfW_BladedFFWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -603,16 +640,29 @@ SUBROUTINE IfW_BladedFFWind_CopyParam( SrcParamData, DstParamData, CtrlCode, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IfW_BladedFFWind_CopyParam - SUBROUTINE IfW_BladedFFWind_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE IfW_BladedFFWind_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_BladedFFWind_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_BladedFFWind_DestroyParam' + LOGICAL,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_BladedFFWind_DestroyParam' + ErrStat = ErrID_None ErrMsg = "" - CALL IfW_FFWind_DestroyParam( ParamData%FF, ErrStat, ErrMsg ) + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL IfW_FFWind_DestroyParam( ParamData%FF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IfW_BladedFFWind_DestroyParam SUBROUTINE IfW_BladedFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) diff --git a/modules/inflowwind/src/IfW_FFWind_Base_Types.f90 b/modules/inflowwind/src/IfW_FFWind_Base_Types.f90 index ffc3ddafd7..e869a36de9 100644 --- a/modules/inflowwind/src/IfW_FFWind_Base_Types.f90 +++ b/modules/inflowwind/src/IfW_FFWind_Base_Types.f90 @@ -106,15 +106,27 @@ SUBROUTINE IfW_FFWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCod DstInitInputData%XOffset = SrcInitInputData%XOffset END SUBROUTINE IfW_FFWind_CopyInitInput - SUBROUTINE IfW_FFWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_FFWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_FFWind_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FFWind_DestroyInitInput' + LOGICAL,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_FFWind_DestroyInitInput' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_FFWind_DestroyInitInput SUBROUTINE IfW_FFWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -348,15 +360,27 @@ SUBROUTINE IfW_FFWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, DstParamData%Z0 = SrcParamData%Z0 END SUBROUTINE IfW_FFWind_CopyParam - SUBROUTINE IfW_FFWind_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE IfW_FFWind_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_FFWind_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FFWind_DestroyParam' + LOGICAL,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_FFWind_DestroyParam' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + IF (ALLOCATED(ParamData%FFData)) THEN DEALLOCATE(ParamData%FFData) ENDIF diff --git a/modules/inflowwind/src/IfW_HAWCWind_Types.f90 b/modules/inflowwind/src/IfW_HAWCWind_Types.f90 index 8fce841f50..126947f674 100644 --- a/modules/inflowwind/src/IfW_HAWCWind_Types.f90 +++ b/modules/inflowwind/src/IfW_HAWCWind_Types.f90 @@ -118,16 +118,29 @@ SUBROUTINE IfW_HAWCWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlC IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IfW_HAWCWind_CopyInitInput - SUBROUTINE IfW_HAWCWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_HAWCWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_HAWCWind_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_DestroyInitInput' + LOGICAL,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_HAWCWind_DestroyInitInput' + ErrStat = ErrID_None ErrMsg = "" - CALL IfW_FFWind_DestroyInitInput( InitInputData%FF, ErrStat, ErrMsg ) + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL IfW_FFWind_DestroyInitInput( InitInputData%FF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IfW_HAWCWind_DestroyInitInput SUBROUTINE IfW_HAWCWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -381,16 +394,29 @@ SUBROUTINE IfW_HAWCWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, Ct DstInitOutputData%SF = SrcInitOutputData%SF END SUBROUTINE IfW_HAWCWind_CopyInitOutput - SUBROUTINE IfW_HAWCWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_HAWCWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_HAWCWind_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_DestroyInitOutput' + LOGICAL,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_HAWCWind_DestroyInitOutput' + ErrStat = ErrID_None ErrMsg = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 IfW_HAWCWind_DestroyInitOutput SUBROUTINE IfW_HAWCWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -600,15 +626,27 @@ SUBROUTINE IfW_HAWCWind_CopyContState( SrcContStateData, DstContStateData, CtrlC DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE IfW_HAWCWind_CopyContState - SUBROUTINE IfW_HAWCWind_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE IfW_HAWCWind_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_HAWCWind_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_DestroyContState' + LOGICAL,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_HAWCWind_DestroyContState' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_HAWCWind_DestroyContState SUBROUTINE IfW_HAWCWind_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -725,15 +763,27 @@ SUBROUTINE IfW_HAWCWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlC DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE IfW_HAWCWind_CopyDiscState - SUBROUTINE IfW_HAWCWind_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE IfW_HAWCWind_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_HAWCWind_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_DestroyDiscState' + LOGICAL,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_HAWCWind_DestroyDiscState' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_HAWCWind_DestroyDiscState SUBROUTINE IfW_HAWCWind_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -850,15 +900,27 @@ SUBROUTINE IfW_HAWCWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE IfW_HAWCWind_CopyConstrState - SUBROUTINE IfW_HAWCWind_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE IfW_HAWCWind_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_HAWCWind_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_DestroyConstrState' + LOGICAL,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_HAWCWind_DestroyConstrState' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_HAWCWind_DestroyConstrState SUBROUTINE IfW_HAWCWind_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -975,15 +1037,27 @@ SUBROUTINE IfW_HAWCWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, Ct DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE IfW_HAWCWind_CopyOtherState - SUBROUTINE IfW_HAWCWind_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE IfW_HAWCWind_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_HAWCWind_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_DestroyOtherState' + LOGICAL,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_HAWCWind_DestroyOtherState' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_HAWCWind_DestroyOtherState SUBROUTINE IfW_HAWCWind_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1100,15 +1174,27 @@ SUBROUTINE IfW_HAWCWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, E DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE IfW_HAWCWind_CopyMisc - SUBROUTINE IfW_HAWCWind_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE IfW_HAWCWind_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_HAWCWind_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_DestroyMisc' + LOGICAL,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_HAWCWind_DestroyMisc' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_HAWCWind_DestroyMisc SUBROUTINE IfW_HAWCWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1227,16 +1313,29 @@ SUBROUTINE IfW_HAWCWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IfW_HAWCWind_CopyParam - SUBROUTINE IfW_HAWCWind_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE IfW_HAWCWind_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_HAWCWind_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_DestroyParam' + LOGICAL,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_HAWCWind_DestroyParam' + ErrStat = ErrID_None ErrMsg = "" - CALL IfW_FFWind_DestroyParam( ParamData%FF, ErrStat, ErrMsg ) + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL IfW_FFWind_DestroyParam( ParamData%FF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IfW_HAWCWind_DestroyParam SUBROUTINE IfW_HAWCWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1449,15 +1548,27 @@ SUBROUTINE IfW_HAWCWind_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat ENDIF END SUBROUTINE IfW_HAWCWind_CopyInput - SUBROUTINE IfW_HAWCWind_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_HAWCWind_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_HAWCWind_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_DestroyInput' + LOGICAL,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_HAWCWind_DestroyInput' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + IF (ALLOCATED(InputData%Position)) THEN DEALLOCATE(InputData%Position) ENDIF diff --git a/modules/inflowwind/src/IfW_TSFFWind_Types.f90 b/modules/inflowwind/src/IfW_TSFFWind_Types.f90 index e3fe8d9185..5f52f9c1c9 100644 --- a/modules/inflowwind/src/IfW_TSFFWind_Types.f90 +++ b/modules/inflowwind/src/IfW_TSFFWind_Types.f90 @@ -74,15 +74,27 @@ SUBROUTINE IfW_TSFFWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlC DstInitInputData%SumFileUnit = SrcInitInputData%SumFileUnit END SUBROUTINE IfW_TSFFWind_CopyInitInput - SUBROUTINE IfW_TSFFWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_TSFFWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_TSFFWind_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_TSFFWind_DestroyInitInput' + LOGICAL,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_TSFFWind_DestroyInitInput' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_TSFFWind_DestroyInitInput SUBROUTINE IfW_TSFFWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -210,16 +222,29 @@ SUBROUTINE IfW_TSFFWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, Ct IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IfW_TSFFWind_CopyInitOutput - SUBROUTINE IfW_TSFFWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_TSFFWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_TSFFWind_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_TSFFWind_DestroyInitOutput' + LOGICAL,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_TSFFWind_DestroyInitOutput' + ErrStat = ErrID_None ErrMsg = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 IfW_TSFFWind_DestroyInitOutput SUBROUTINE IfW_TSFFWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -417,15 +442,27 @@ SUBROUTINE IfW_TSFFWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, E DstMiscData%dummy = SrcMiscData%dummy END SUBROUTINE IfW_TSFFWind_CopyMisc - SUBROUTINE IfW_TSFFWind_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE IfW_TSFFWind_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_TSFFWind_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_TSFFWind_DestroyMisc' + LOGICAL,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_TSFFWind_DestroyMisc' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_TSFFWind_DestroyMisc SUBROUTINE IfW_TSFFWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -544,16 +581,29 @@ SUBROUTINE IfW_TSFFWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IfW_TSFFWind_CopyParam - SUBROUTINE IfW_TSFFWind_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE IfW_TSFFWind_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_TSFFWind_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_TSFFWind_DestroyParam' + LOGICAL,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_TSFFWind_DestroyParam' + ErrStat = ErrID_None ErrMsg = "" - CALL IfW_FFWind_DestroyParam( ParamData%FF, ErrStat, ErrMsg ) + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL IfW_FFWind_DestroyParam( ParamData%FF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IfW_TSFFWind_DestroyParam SUBROUTINE IfW_TSFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) diff --git a/modules/inflowwind/src/IfW_UniformWind_Types.f90 b/modules/inflowwind/src/IfW_UniformWind_Types.f90 index 8c344bd7c5..6007f774e4 100644 --- a/modules/inflowwind/src/IfW_UniformWind_Types.f90 +++ b/modules/inflowwind/src/IfW_UniformWind_Types.f90 @@ -111,16 +111,29 @@ SUBROUTINE IfW_UniformWind_CopyInitInput( SrcInitInputData, DstInitInputData, Ct IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IfW_UniformWind_CopyInitInput - SUBROUTINE IfW_UniformWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_UniformWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_UniformWind_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UniformWind_DestroyInitInput' + LOGICAL,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_UniformWind_DestroyInitInput' + ErrStat = ErrID_None ErrMsg = "" - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedFileData, ErrStat, 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) END SUBROUTINE IfW_UniformWind_DestroyInitInput SUBROUTINE IfW_UniformWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -355,16 +368,29 @@ SUBROUTINE IfW_UniformWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, DstInitOutputData%WindFileConstantDT = SrcInitOutputData%WindFileConstantDT END SUBROUTINE IfW_UniformWind_CopyInitOutput - SUBROUTINE IfW_UniformWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_UniformWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_UniformWind_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UniformWind_DestroyInitOutput' + LOGICAL,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_UniformWind_DestroyInitOutput' + ErrStat = ErrID_None ErrMsg = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 IfW_UniformWind_DestroyInitOutput SUBROUTINE IfW_UniformWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -589,15 +615,27 @@ SUBROUTINE IfW_UniformWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat DstMiscData%TimeIndex = SrcMiscData%TimeIndex END SUBROUTINE IfW_UniformWind_CopyMisc - SUBROUTINE IfW_UniformWind_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE IfW_UniformWind_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_UniformWind_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UniformWind_DestroyMisc' + LOGICAL,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_UniformWind_DestroyMisc' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_UniformWind_DestroyMisc SUBROUTINE IfW_UniformWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -825,15 +863,27 @@ SUBROUTINE IfW_UniformWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrS DstParamData%NumDataLines = SrcParamData%NumDataLines END SUBROUTINE IfW_UniformWind_CopyParam - SUBROUTINE IfW_UniformWind_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE IfW_UniformWind_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_UniformWind_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UniformWind_DestroyParam' + LOGICAL,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_UniformWind_DestroyParam' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + IF (ALLOCATED(ParamData%TData)) THEN DEALLOCATE(ParamData%TData) ENDIF @@ -1337,15 +1387,27 @@ SUBROUTINE IfW_UniformWind_CopyIntrp( SrcIntrpData, DstIntrpData, CtrlCode, ErrS DstIntrpData%VGUST = SrcIntrpData%VGUST END SUBROUTINE IfW_UniformWind_CopyIntrp - SUBROUTINE IfW_UniformWind_DestroyIntrp( IntrpData, ErrStat, ErrMsg ) + SUBROUTINE IfW_UniformWind_DestroyIntrp( IntrpData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_UniformWind_Intrp), INTENT(INOUT) :: IntrpData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UniformWind_DestroyIntrp' + LOGICAL,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_UniformWind_DestroyIntrp' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_UniformWind_DestroyIntrp SUBROUTINE IfW_UniformWind_PackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) diff --git a/modules/inflowwind/src/IfW_UserWind_Types.f90 b/modules/inflowwind/src/IfW_UserWind_Types.f90 index 1fa5c484ac..6f7c2fe094 100644 --- a/modules/inflowwind/src/IfW_UserWind_Types.f90 +++ b/modules/inflowwind/src/IfW_UserWind_Types.f90 @@ -71,15 +71,27 @@ SUBROUTINE IfW_UserWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlC DstInitInputData%WindFileName = SrcInitInputData%WindFileName END SUBROUTINE IfW_UserWind_CopyInitInput - SUBROUTINE IfW_UserWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_UserWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_UserWind_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_DestroyInitInput' + LOGICAL,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_UserWind_DestroyInitInput' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_UserWind_DestroyInitInput SUBROUTINE IfW_UserWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -202,16 +214,29 @@ SUBROUTINE IfW_UserWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, Ct IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IfW_UserWind_CopyInitOutput - SUBROUTINE IfW_UserWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE IfW_UserWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_UserWind_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_DestroyInitOutput' + LOGICAL,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_UserWind_DestroyInitOutput' + ErrStat = ErrID_None ErrMsg = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 IfW_UserWind_DestroyInitOutput SUBROUTINE IfW_UserWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -409,15 +434,27 @@ SUBROUTINE IfW_UserWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, E DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE IfW_UserWind_CopyMisc - SUBROUTINE IfW_UserWind_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE IfW_UserWind_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_UserWind_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_DestroyMisc' + LOGICAL,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_UserWind_DestroyMisc' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_UserWind_DestroyMisc SUBROUTINE IfW_UserWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -534,15 +571,27 @@ SUBROUTINE IfW_UserWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat DstParamData%dummy = SrcParamData%dummy END SUBROUTINE IfW_UserWind_CopyParam - SUBROUTINE IfW_UserWind_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE IfW_UserWind_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IfW_UserWind_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_DestroyParam' + LOGICAL,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_UserWind_DestroyParam' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE IfW_UserWind_DestroyParam SUBROUTINE IfW_UserWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) diff --git a/modules/inflowwind/src/InflowWind_Driver_Subs.f90 b/modules/inflowwind/src/InflowWind_Driver_Subs.f90 index c10193ae68..b6edb09f42 100644 --- a/modules/inflowwind/src/InflowWind_Driver_Subs.f90 +++ b/modules/inflowwind/src/InflowWind_Driver_Subs.f90 @@ -2343,10 +2343,11 @@ SUBROUTINE PointsVel_OutputWrite (FileUnit, FileName, Initialized, Settings, Gri INTEGER(IntKi) :: LenErrMsgTmp !< Length of ErrMsgTmp (for getting WindGrid info) INTEGER(IntKi) :: I !< Generic counter - CHARACTER(61) :: PointsVelFmt !< Format specifier for the output file for wave elevation series + CHARACTER(61) :: NameUnitFmt !< Format specifier for the output file for channel names and units + CHARACTER(61) :: PointsVelFmt !< Format specifier for the output file for wind point location and velocity - - PointsVelFmt = "(F14.7,3x,F14.7,3x,F14.7,3x,F14.7,3x,F14.7,3x,F14.7,3x,F14.7)" + NameUnitFmt = "( 7(A16, 3X) )" + PointsVelFmt = "( 7(F16.8, 3X) )" ErrMsg = '' ErrStat = ErrID_None @@ -2371,15 +2372,16 @@ SUBROUTINE PointsVel_OutputWrite (FileUnit, FileName, Initialized, Settings, Gri TRIM(Num2LStr(SIZE(GridXYZ,DIM=2)))//' points specified in the '// & 'file '//TRIM(Settings%PointsFileName)//'.' WRITE (FileUnit,'(A)', IOSTAT=ErrStatTmp ) '# ' - WRITE (FileUnit,'(A)', IOSTAT=ErrStatTmp ) '# T X Y Z '// & - ' U V W' - WRITE (FileUnit,'(A)', IOSTAT=ErrStatTmp ) '# (s) (m) (m) (m) '// & - ' (m/s) (m/s) (m/s)' + WRITE (FileUnit,'(A)', IOSTAT=ErrStatTmp ) '# ' + WRITE (FileUnit,'(A)', IOSTAT=ErrStatTmp ) '# ' + WRITE (FileUnit,'(A)', IOSTAT=ErrStatTmp ) '# ' + WRITE (FileUnit, NameUnitFmt, IOSTAT=ErrStatTmp ) 'T', 'X', 'Y', 'Z', 'U', 'V', 'W' + WRITE (FileUnit, NameUnitFmt, IOSTAT=ErrStatTmp ) '(s)', '(m)', '(m)', '(m)', '(m/s)', '(m/s)', '(m/s)' ELSE DO I = 1,SIZE(GridXYZ,DIM=2) - WRITE (FileUnit,PointsVelFmt, IOSTAT=ErrStatTmp ) TIME,GridXYZ(1,I),GridXYZ(2,I),GridXYZ(3,I),GridVel(1,I),GridVel(2,I),GridVel(3,I) + WRITE (FileUnit, PointsVelFmt, IOSTAT=ErrStatTmp ) TIME, GridXYZ(1,I), GridXYZ(2,I), GridXYZ(3,I), GridVel(1,I), GridVel(2,I), GridVel(3,I) ENDDO diff --git a/modules/inflowwind/src/InflowWind_Subs.f90 b/modules/inflowwind/src/InflowWind_Subs.f90 index 2499deb117..42f83292f1 100644 --- a/modules/inflowwind/src/InflowWind_Subs.f90 +++ b/modules/inflowwind/src/InflowWind_Subs.f90 @@ -48,11 +48,6 @@ MODULE InflowWind_Subs ! This code was generated by Write_ChckOutLst.m at 26-Oct-2020 15:42:27. - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - ! Indices for computing output channels: ! NOTES: ! (1) These parameters are in the order stored in "OutListParameters.xlsx" @@ -449,8 +444,7 @@ SUBROUTINE InflowWind_ParseInputFileInfo( InputFileData, InFileInfo, PriPath, In !---------------------- OUTLIST -------------------------------------------- CurLine = CurLine + 1 ! Skip comment line - CALL ReadOutputListFromFileInfo( InFileInfo, CurLine, InputFileData%OutList, & - InputFileData%NumOuts, "OutList", "List of user-requested output channels", TmpErrStat, TmpErrMsg, UnEc ) + CALL ReadOutputListFromFileInfo( InFileInfo, CurLine, InputFileData%OutList, InputFileData%NumOuts, TmpErrStat, TmpErrMsg, UnEc ) if (Failed()) return !------------------------------------------------------------------------------------------------- @@ -1016,7 +1010,7 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) INTEGER :: ErrStat2 ! temporary (local) error status INTEGER :: I ! Generic loop-counting index - INTEGER :: J ! 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) diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 8575aab02f..c7b6968cb2 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -255,15 +255,27 @@ SUBROUTINE InflowWind_CopyWindFileMetaData( SrcWindFileMetaDataData, DstWindFile DstWindFileMetaDataData%MWS = SrcWindFileMetaDataData%MWS END SUBROUTINE InflowWind_CopyWindFileMetaData - SUBROUTINE InflowWind_DestroyWindFileMetaData( WindFileMetaDataData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyWindFileMetaData( WindFileMetaDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WindFileMetaData), INTENT(INOUT) :: WindFileMetaDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyWindFileMetaData' + LOGICAL,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_DestroyWindFileMetaData' + ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + END SUBROUTINE InflowWind_DestroyWindFileMetaData SUBROUTINE InflowWind_PackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -578,15 +590,27 @@ SUBROUTINE InflowWind_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE InflowWind_CopyInputFile - SUBROUTINE InflowWind_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInputFile' + LOGICAL,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 @@ -599,7 +623,8 @@ SUBROUTINE InflowWind_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) IF (ALLOCATED(InputFileData%OutList)) THEN DEALLOCATE(InputFileData%OutList) ENDIF - CALL IfW_FFWind_DestroyInitInput( InputFileData%FF, ErrStat, ErrMsg ) + CALL IfW_FFWind_DestroyInitInput( 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 ) @@ -1172,19 +1197,35 @@ SUBROUTINE InflowWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE InflowWind_CopyInitInput - SUBROUTINE InflowWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInitInput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedFileData, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroyfileinfotype( InitInputData%WindType2Data, ErrStat, ErrMsg ) - CALL Lidar_DestroyInitInput( InitInputData%lidar, ErrStat, ErrMsg ) - CALL IfW_4Dext_DestroyInitInput( InitInputData%FDext, ErrStat, 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 IfW_4Dext_DestroyInitInput( 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 ) @@ -1780,23 +1821,37 @@ SUBROUTINE InflowWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, Ctrl ENDIF END SUBROUTINE InflowWind_CopyInitOutput - SUBROUTINE InflowWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInitOutput' + LOGICAL,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, ErrStat, ErrMsg ) - CALL InflowWind_Destroywindfilemetadata( InitOutputData%WindFileInfo, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_Destroywindfilemetadata( InitOutputData%WindFileInfo, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%LinNames_y)) THEN DEALLOCATE(InitOutputData%LinNames_y) ENDIF @@ -2423,21 +2478,39 @@ SUBROUTINE InflowWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE InflowWind_CopyMisc - SUBROUTINE InflowWind_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyMisc' + LOGICAL,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 = "" - CALL IfW_UniformWind_DestroyMisc( MiscData%UniformWind, ErrStat, ErrMsg ) - CALL IfW_TSFFWind_DestroyMisc( MiscData%TSFFWind, ErrStat, ErrMsg ) - CALL IfW_HAWCWind_DestroyMisc( MiscData%HAWCWind, ErrStat, ErrMsg ) - CALL IfW_BladedFFWind_DestroyMisc( MiscData%BladedFFWind, ErrStat, ErrMsg ) - CALL IfW_UserWind_DestroyMisc( MiscData%UserWind, ErrStat, ErrMsg ) - CALL IfW_4Dext_DestroyMisc( MiscData%FDext, ErrStat, ErrMsg ) + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL IfW_UniformWind_DestroyMisc( MiscData%UniformWind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL IfW_TSFFWind_DestroyMisc( MiscData%TSFFWind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL IfW_HAWCWind_DestroyMisc( MiscData%HAWCWind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL IfW_BladedFFWind_DestroyMisc( MiscData%BladedFFWind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL IfW_UserWind_DestroyMisc( MiscData%UserWind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL IfW_4Dext_DestroyMisc( MiscData%FDext, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%AllOuts)) THEN DEALLOCATE(MiscData%AllOuts) ENDIF @@ -3252,37 +3325,57 @@ SUBROUTINE InflowWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE InflowWind_CopyParam - SUBROUTINE InflowWind_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyParam' + LOGICAL,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_UniformWind_DestroyParam( ParamData%UniformWind, ErrStat, ErrMsg ) - CALL IfW_TSFFWind_DestroyParam( ParamData%TSFFWind, ErrStat, ErrMsg ) - CALL IfW_BladedFFWind_DestroyParam( ParamData%BladedFFWind, ErrStat, ErrMsg ) - CALL IfW_HAWCWind_DestroyParam( ParamData%HAWCWind, ErrStat, ErrMsg ) - CALL IfW_UserWind_DestroyParam( ParamData%UserWind, ErrStat, ErrMsg ) - CALL IfW_4Dext_DestroyParam( ParamData%FDext, ErrStat, ErrMsg ) + CALL IfW_UniformWind_DestroyParam( ParamData%UniformWind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL IfW_TSFFWind_DestroyParam( ParamData%TSFFWind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL IfW_BladedFFWind_DestroyParam( ParamData%BladedFFWind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL IfW_HAWCWind_DestroyParam( ParamData%HAWCWind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL IfW_UserWind_DestroyParam( ParamData%UserWind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL IfW_4Dext_DestroyParam( ParamData%FDext, 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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 ) @@ -4373,19 +4466,32 @@ SUBROUTINE InflowWind_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE InflowWind_CopyInput - SUBROUTINE InflowWind_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 ) @@ -4664,22 +4770,35 @@ SUBROUTINE InflowWind_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrSta IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE InflowWind_CopyOutput - SUBROUTINE InflowWind_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyOutput' + LOGICAL,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%WriteOutput)) THEN DEALLOCATE(OutputData%WriteOutput) ENDIF - CALL Lidar_DestroyOutput( OutputData%lidar, ErrStat, ErrMsg ) + 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 ) @@ -4976,15 +5095,27 @@ SUBROUTINE InflowWind_CopyContState( SrcContStateData, DstContStateData, CtrlCod DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE InflowWind_CopyContState - SUBROUTINE InflowWind_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyContState' + LOGICAL,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 ) @@ -5101,15 +5232,27 @@ SUBROUTINE InflowWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCod DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE InflowWind_CopyDiscState - SUBROUTINE InflowWind_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyDiscState' + LOGICAL,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 ) @@ -5226,15 +5369,27 @@ SUBROUTINE InflowWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, C DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE InflowWind_CopyConstrState - SUBROUTINE InflowWind_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyConstrState' + LOGICAL,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 ) @@ -5351,15 +5506,27 @@ SUBROUTINE InflowWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, Ctrl DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE InflowWind_CopyOtherState - SUBROUTINE InflowWind_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE InflowWind_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(InflowWind_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyOtherState' + LOGICAL,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 ) diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 4ec86f6a34..a26f87edd8 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -130,15 +130,27 @@ SUBROUTINE Lidar_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%LidRadialVel = SrcInitInputData%LidRadialVel END SUBROUTINE Lidar_CopyInitInput - SUBROUTINE Lidar_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE Lidar_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Lidar_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInitInput' + LOGICAL,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 ) @@ -293,15 +305,27 @@ SUBROUTINE Lidar_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut END SUBROUTINE Lidar_CopyInitOutput - SUBROUTINE Lidar_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE Lidar_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Lidar_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInitOutput' + LOGICAL,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 ) @@ -429,15 +453,27 @@ SUBROUTINE Lidar_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%LidRadialVel = SrcParamData%LidRadialVel END SUBROUTINE Lidar_CopyParam - SUBROUTINE Lidar_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE Lidar_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Lidar_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyParam' + LOGICAL,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 + END SUBROUTINE Lidar_DestroyParam SUBROUTINE Lidar_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -611,15 +647,27 @@ SUBROUTINE Lidar_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Er DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE Lidar_CopyContState - SUBROUTINE Lidar_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE Lidar_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Lidar_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyContState' + LOGICAL,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 ) @@ -736,15 +784,27 @@ SUBROUTINE Lidar_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Er DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE Lidar_CopyDiscState - SUBROUTINE Lidar_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE Lidar_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Lidar_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyDiscState' + LOGICAL,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 ) @@ -861,15 +921,27 @@ SUBROUTINE Lidar_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCo DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE Lidar_CopyConstrState - SUBROUTINE Lidar_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE Lidar_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Lidar_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyConstrState' + LOGICAL,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 ) @@ -986,15 +1058,27 @@ SUBROUTINE Lidar_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE Lidar_CopyOtherState - SUBROUTINE Lidar_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE Lidar_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Lidar_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyOtherState' + LOGICAL,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 ) @@ -1111,15 +1195,27 @@ SUBROUTINE Lidar_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE Lidar_CopyMisc - SUBROUTINE Lidar_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE Lidar_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Lidar_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyMisc' + LOGICAL,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 ) @@ -1240,15 +1336,27 @@ SUBROUTINE Lidar_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs DstInputData%PulseLidAz = SrcInputData%PulseLidAz END SUBROUTINE Lidar_CopyInput - SUBROUTINE Lidar_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE Lidar_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Lidar_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInput' + LOGICAL,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 ) @@ -1417,15 +1525,27 @@ SUBROUTINE Lidar_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er ENDIF END SUBROUTINE Lidar_CopyOutput - SUBROUTINE Lidar_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE Lidar_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Lidar_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyOutput' + LOGICAL,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 diff --git a/modules/map/CMakeLists.txt b/modules/map/CMakeLists.txt index 2bf1de3f4c..2589d5a893 100644 --- a/modules/map/CMakeLists.txt +++ b/modules/map/CMakeLists.txt @@ -19,6 +19,11 @@ if(WIN32 OR CYGWIN OR MINGW) set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -DMAP_DLL_EXPORTS -DCMINPACK_NO_DLL -DNDEBUG -D_WINDOWS -D_USRDLL") endif() +if (${CMAKE_CXX_COMPILER_ID} STREQUAL "GNU" AND NOT WIN32) + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -fPIC") + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fPIC") +endif() + if (GENERATE_TYPES) generate_f90_types(src/MAP_Fortran_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Fortran_Types.f90 -noextrap) generate_f90_types(src/MAP_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Types.f90 -ccode) diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index 47c34ab7c1..4bed537cd2 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -72,15 +72,27 @@ SUBROUTINE MAP_Fortran_CopyLin_InitInputType( SrcLin_InitInputTypeData, DstLin_I DstLin_InitInputTypeData%linearize = SrcLin_InitInputTypeData%linearize END SUBROUTINE MAP_Fortran_CopyLin_InitInputType - SUBROUTINE MAP_Fortran_DestroyLin_InitInputType( Lin_InitInputTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitInputType' + LOGICAL,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 ) @@ -235,15 +247,27 @@ SUBROUTINE MAP_Fortran_CopyLin_InitOutputType( SrcLin_InitOutputTypeData, DstLin ENDIF END SUBROUTINE MAP_Fortran_CopyLin_InitOutputType - SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType( Lin_InitOutputTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitOutputType' + LOGICAL,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 @@ -504,15 +528,27 @@ SUBROUTINE MAP_Fortran_CopyLin_ParamType( SrcLin_ParamTypeData, DstLin_ParamType DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny END SUBROUTINE MAP_Fortran_CopyLin_ParamType - SUBROUTINE MAP_Fortran_DestroyLin_ParamType( Lin_ParamTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_ParamType' + LOGICAL,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 diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index af274d629f..d179fa96e9 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -285,16 +285,29 @@ SUBROUTINE MAP_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyInitInput - SUBROUTINE MAP_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInitInput' + LOGICAL,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 = "" - CALL MAP_Fortran_Destroylin_initinputtype( InitInputData%LinInitInp, ErrStat, 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 SUBROUTINE MAP_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -661,23 +674,37 @@ SUBROUTINE MAP_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyInitOutput - SUBROUTINE MAP_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInitOutput' + LOGICAL,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, ErrStat, ErrMsg ) - CALL MAP_Fortran_Destroylin_initoutputtype( InitOutputData%LinInitOut, ErrStat, ErrMsg ) + 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 ) @@ -1118,15 +1145,27 @@ SUBROUTINE MAP_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrS DstContStateData%C_obj%dummy = SrcContStateData%C_obj%dummy END SUBROUTINE MAP_CopyContState - SUBROUTINE MAP_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyContState' + LOGICAL,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 ) @@ -1283,15 +1322,27 @@ SUBROUTINE MAP_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS DstDiscStateData%C_obj%dummy = SrcDiscStateData%C_obj%dummy END SUBROUTINE MAP_CopyDiscState - SUBROUTINE MAP_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyDiscState' + LOGICAL,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 ) @@ -1456,7 +1507,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%H = C_LOC( DstOtherStateData%H( i1_l ) ) END IF DstOtherStateData%H = SrcOtherStateData%H ENDIF @@ -1471,7 +1522,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%V = C_LOC( DstOtherStateData%V( i1_l ) ) END IF DstOtherStateData%V = SrcOtherStateData%V ENDIF @@ -1486,7 +1537,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%Ha = C_LOC( DstOtherStateData%Ha( i1_l ) ) END IF DstOtherStateData%Ha = SrcOtherStateData%Ha ENDIF @@ -1501,7 +1552,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%Va = C_LOC( DstOtherStateData%Va( i1_l ) ) END IF DstOtherStateData%Va = SrcOtherStateData%Va ENDIF @@ -1516,7 +1567,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%x = C_LOC( DstOtherStateData%x( i1_l ) ) END IF DstOtherStateData%x = SrcOtherStateData%x ENDIF @@ -1531,7 +1582,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%y = C_LOC( DstOtherStateData%y( i1_l ) ) END IF DstOtherStateData%y = SrcOtherStateData%y ENDIF @@ -1546,7 +1597,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%z = C_LOC( DstOtherStateData%z( i1_l ) ) END IF DstOtherStateData%z = SrcOtherStateData%z ENDIF @@ -1561,7 +1612,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%xa = C_LOC( DstOtherStateData%xa( i1_l ) ) END IF DstOtherStateData%xa = SrcOtherStateData%xa ENDIF @@ -1576,7 +1627,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%ya = C_LOC( DstOtherStateData%ya( i1_l ) ) END IF DstOtherStateData%ya = SrcOtherStateData%ya ENDIF @@ -1591,7 +1642,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%za = C_LOC( DstOtherStateData%za( i1_l ) ) END IF DstOtherStateData%za = SrcOtherStateData%za ENDIF @@ -1606,7 +1657,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%Fx_connect = C_LOC( DstOtherStateData%Fx_connect( i1_l ) ) END IF DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect ENDIF @@ -1621,7 +1672,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%Fy_connect = C_LOC( DstOtherStateData%Fy_connect( i1_l ) ) END IF DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect ENDIF @@ -1636,7 +1687,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%Fz_connect = C_LOC( DstOtherStateData%Fz_connect( i1_l ) ) END IF DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect ENDIF @@ -1651,7 +1702,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%Fx_anchor = C_LOC( DstOtherStateData%Fx_anchor( i1_l ) ) END IF DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor ENDIF @@ -1666,7 +1717,7 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + DstOtherStateData%c_obj%Fy_anchor = C_LOC( DstOtherStateData%Fy_anchor( i1_l ) ) END IF DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor ENDIF @@ -1681,112 +1732,140 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E 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) ) + 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 ) + SUBROUTINE MAP_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyOtherState' + LOGICAL,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 @@ -2222,7 +2301,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2243,7 +2322,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2264,7 +2343,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2285,7 +2364,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2306,7 +2385,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2327,7 +2406,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2348,7 +2427,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2369,7 +2448,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2390,7 +2469,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2411,7 +2490,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2432,7 +2511,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2453,7 +2532,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2474,7 +2553,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2495,7 +2574,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2516,7 +2595,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2537,7 +2616,7 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -2730,7 +2809,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%H = C_LOC( OtherStateData%H( LBOUND(OtherStateData%H,1) ) ) END IF END IF @@ -2742,7 +2821,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%V = C_LOC( OtherStateData%V( LBOUND(OtherStateData%V,1) ) ) END IF END IF @@ -2754,7 +2833,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%Ha = C_LOC( OtherStateData%Ha( LBOUND(OtherStateData%Ha,1) ) ) END IF END IF @@ -2766,7 +2845,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%Va = C_LOC( OtherStateData%Va( LBOUND(OtherStateData%Va,1) ) ) END IF END IF @@ -2778,7 +2857,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%x = C_LOC( OtherStateData%x( LBOUND(OtherStateData%x,1) ) ) END IF END IF @@ -2790,7 +2869,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%y = C_LOC( OtherStateData%y( LBOUND(OtherStateData%y,1) ) ) END IF END IF @@ -2802,7 +2881,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%z = C_LOC( OtherStateData%z( LBOUND(OtherStateData%z,1) ) ) END IF END IF @@ -2814,7 +2893,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%xa = C_LOC( OtherStateData%xa( LBOUND(OtherStateData%xa,1) ) ) END IF END IF @@ -2826,7 +2905,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%ya = C_LOC( OtherStateData%ya( LBOUND(OtherStateData%ya,1) ) ) END IF END IF @@ -2838,7 +2917,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%za = C_LOC( OtherStateData%za( LBOUND(OtherStateData%za,1) ) ) END IF END IF @@ -2850,7 +2929,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%Fx_connect = C_LOC( OtherStateData%Fx_connect( LBOUND(OtherStateData%Fx_connect,1) ) ) END IF END IF @@ -2862,7 +2941,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%Fy_connect = C_LOC( OtherStateData%Fy_connect( LBOUND(OtherStateData%Fy_connect,1) ) ) END IF END IF @@ -2874,7 +2953,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%Fz_connect = C_LOC( OtherStateData%Fz_connect( LBOUND(OtherStateData%Fz_connect,1) ) ) END IF END IF @@ -2886,7 +2965,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%Fx_anchor = C_LOC( OtherStateData%Fx_anchor( LBOUND(OtherStateData%Fx_anchor,1) ) ) END IF END IF @@ -2898,7 +2977,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%Fy_anchor = C_LOC( OtherStateData%Fy_anchor( LBOUND(OtherStateData%Fy_anchor,1) ) ) END IF END IF @@ -2910,7 +2989,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers 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) ) ) + OtherStateData%c_obj%Fz_anchor = C_LOC( OtherStateData%Fz_anchor( LBOUND(OtherStateData%Fz_anchor,1) ) ) END IF END IF END SUBROUTINE MAP_F2C_CopyOtherState @@ -2941,7 +3020,7 @@ SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode 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) ) + DstConstrStateData%c_obj%H = C_LOC( DstConstrStateData%H( i1_l ) ) END IF DstConstrStateData%H = SrcConstrStateData%H ENDIF @@ -2956,7 +3035,7 @@ SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode 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) ) + DstConstrStateData%c_obj%V = C_LOC( DstConstrStateData%V( i1_l ) ) END IF DstConstrStateData%V = SrcConstrStateData%V ENDIF @@ -2971,7 +3050,7 @@ SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode 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) ) + DstConstrStateData%c_obj%x = C_LOC( DstConstrStateData%x( i1_l ) ) END IF DstConstrStateData%x = SrcConstrStateData%x ENDIF @@ -2986,7 +3065,7 @@ SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode 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) ) + DstConstrStateData%c_obj%y = C_LOC( DstConstrStateData%y( i1_l ) ) END IF DstConstrStateData%y = SrcConstrStateData%y ENDIF @@ -3001,46 +3080,63 @@ SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode 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) ) + 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 ) + SUBROUTINE MAP_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyConstrState' + LOGICAL,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 @@ -3256,7 +3352,7 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) ) + 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 @@ -3277,7 +3373,7 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) ) + 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 @@ -3298,7 +3394,7 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) ) + 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 @@ -3319,7 +3415,7 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) ) + 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 @@ -3340,7 +3436,7 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) ) + 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 @@ -3434,7 +3530,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe 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) ) ) + ConstrStateData%c_obj%H = C_LOC( ConstrStateData%H( LBOUND(ConstrStateData%H,1) ) ) END IF END IF @@ -3446,7 +3542,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe 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) ) ) + ConstrStateData%c_obj%V = C_LOC( ConstrStateData%V( LBOUND(ConstrStateData%V,1) ) ) END IF END IF @@ -3458,7 +3554,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe 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) ) ) + ConstrStateData%c_obj%x = C_LOC( ConstrStateData%x( LBOUND(ConstrStateData%x,1) ) ) END IF END IF @@ -3470,7 +3566,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe 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) ) ) + ConstrStateData%c_obj%y = C_LOC( ConstrStateData%y( LBOUND(ConstrStateData%y,1) ) ) END IF END IF @@ -3482,7 +3578,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe 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) ) ) + ConstrStateData%c_obj%z = C_LOC( ConstrStateData%z( LBOUND(ConstrStateData%z,1) ) ) END IF END IF END SUBROUTINE MAP_F2C_CopyConstrState @@ -3519,16 +3615,29 @@ SUBROUTINE MAP_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyParam - SUBROUTINE MAP_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE MAP_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyParam' + LOGICAL,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 = "" - CALL MAP_Fortran_Destroylin_paramtype( ParamData%LinParams, ErrStat, 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 ) @@ -3842,7 +3951,7 @@ SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%x = C_LOC( DstInputData%x( i1_l ) ) END IF DstInputData%x = SrcInputData%x ENDIF @@ -3857,7 +3966,7 @@ SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%y = C_LOC( DstInputData%y( i1_l ) ) END IF DstInputData%y = SrcInputData%y ENDIF @@ -3872,7 +3981,7 @@ SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%z = C_LOC( DstInputData%z( i1_l ) ) END IF DstInputData%z = SrcInputData%z ENDIF @@ -3881,34 +3990,50 @@ SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyInput - SUBROUTINE MAP_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MAP_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 ) @@ -4125,7 +4250,7 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) + 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 @@ -4146,7 +4271,7 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) + 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 @@ -4167,7 +4292,7 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) + 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 @@ -4283,7 +4408,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%x = C_LOC( InputData%x( LBOUND(InputData%x,1) ) ) END IF END IF @@ -4295,7 +4420,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%y = C_LOC( InputData%y( LBOUND(InputData%y,1) ) ) END IF END IF @@ -4307,7 +4432,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%z = C_LOC( InputData%z( LBOUND(InputData%z,1) ) ) END IF END IF END SUBROUTINE MAP_F2C_CopyInput @@ -4338,7 +4463,7 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM 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) ) + DstOutputData%c_obj%Fx = C_LOC( DstOutputData%Fx( i1_l ) ) END IF DstOutputData%Fx = SrcOutputData%Fx ENDIF @@ -4353,7 +4478,7 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM 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) ) + DstOutputData%c_obj%Fy = C_LOC( DstOutputData%Fy( i1_l ) ) END IF DstOutputData%Fy = SrcOutputData%Fy ENDIF @@ -4368,7 +4493,7 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM 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) ) + DstOutputData%c_obj%Fz = C_LOC( DstOutputData%Fz( i1_l ) ) END IF DstOutputData%Fz = SrcOutputData%Fz ENDIF @@ -4395,7 +4520,7 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM 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) ) + DstOutputData%c_obj%wrtOutput = C_LOC( DstOutputData%wrtOutput( i1_l ) ) END IF DstOutputData%wrtOutput = SrcOutputData%wrtOutput ENDIF @@ -4404,28 +4529,43 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyOutput - SUBROUTINE MAP_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyOutput' + LOGICAL,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 @@ -4435,12 +4575,14 @@ SUBROUTINE MAP_DestroyOutput( OutputData, ErrStat, ErrMsg ) 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, ErrStat, ErrMsg ) + 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 ) @@ -4697,7 +4839,7 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -4718,7 +4860,7 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -4739,7 +4881,7 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -4778,7 +4920,7 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -4903,7 +5045,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + OutputData%c_obj%Fx = C_LOC( OutputData%Fx( LBOUND(OutputData%Fx,1) ) ) END IF END IF @@ -4915,7 +5057,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + OutputData%c_obj%Fy = C_LOC( OutputData%Fy( LBOUND(OutputData%Fy,1) ) ) END IF END IF @@ -4927,7 +5069,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + OutputData%c_obj%Fz = C_LOC( OutputData%Fz( LBOUND(OutputData%Fz,1) ) ) END IF END IF @@ -4939,7 +5081,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + OutputData%c_obj%wrtOutput = C_LOC( OutputData%wrtOutput( LBOUND(OutputData%wrtOutput,1) ) ) END IF END IF END SUBROUTINE MAP_F2C_CopyOutput diff --git a/modules/map/src/lineroutines.h b/modules/map/src/lineroutines.h index d34e9ae4c8..26b28835cd 100644 --- a/modules/map/src/lineroutines.h +++ b/modules/map/src/lineroutines.h @@ -96,7 +96,7 @@ MAP_ERROR_CODE increment_the_dof_by_delta(MAP_InputType_t* u_type, const Vessel* MAP_ERROR_CODE increment_psi_dof_by_delta(MAP_InputType_t* u_type, const Vessel* vessel, const double delta, const int size); -MAP_ERROR_CODE f_op_sequence(MAP_OtherStateType_t* other_type, MAP_ParameterType_t* p_type, MAP_InputType_t* u_type, MAP_OutputType_t* y_type, MAP_ConstraintStateType_t* z_type, Fd* force, int size, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_ERROR_CODE f_op_sequence(MAP_OtherStateType_t* other_type, MAP_ParameterType_t* p_type, MAP_InputType_t* u_type, MAP_OutputType_t* y_type, MAP_ConstraintStateType_t* z_type, Fd* force, const int size, char* map_msg, MAP_ERROR_CODE* ierr); MAP_ERROR_CODE fd_x_sequence(MAP_OtherStateType_t* other_type, MAP_ParameterType_t* p_type, MAP_InputType_t* u_type, MAP_OutputType_t* y_type, MAP_ConstraintStateType_t* z_type, Fd* force, const double epsilon, const int size, const double* original_pos, char* map_msg, MAP_ERROR_CODE* ierr); MAP_ERROR_CODE fd_y_sequence(MAP_OtherStateType_t* other_type, MAP_ParameterType_t* p_type, MAP_InputType_t* u_type, MAP_OutputType_t* y_type, MAP_ConstraintStateType_t* z_type, Fd* force, const double epsilon, const int size, const double* original_pos, char* map_msg, MAP_ERROR_CODE* ierr); MAP_ERROR_CODE fd_z_sequence(MAP_OtherStateType_t* other_type, MAP_ParameterType_t* p_type, MAP_InputType_t* u_type, MAP_OutputType_t* y_type, MAP_ConstraintStateType_t* z_type, Fd* force, const double epsilon, const int size, const double* original_pos, char* map_msg, MAP_ERROR_CODE* ierr); diff --git a/modules/map/src/mapinit.c b/modules/map/src/mapinit.c index 4def89c440..3afe39f3a4 100644 --- a/modules/map/src/mapinit.c +++ b/modules/map/src/mapinit.c @@ -1777,7 +1777,7 @@ MAP_ERROR_CODE allocate_types_for_nodes(MAP_InputType_t* u_type, MAP_ConstraintS while (i_parsedqty-1) { /* iterating through all strings */ if (parsed->entry[i_parsed]->slen) { /* if the string length is not 0 */ if (next==1) { - if (biseqcstrcaseless(parsed->entry[i_parsed],"FIX")) { + if (biseqcstrcaseless(parsed->entry[i_parsed],"FIX") || biseqcstrcaseless(parsed->entry[i_parsed],"FIXED")) { fix_num++; break; /* break the while-loop because the agenda is reached */ } else if (biseqcstrcaseless(parsed->entry[i_parsed],"CONNECT")) { @@ -1898,7 +1898,7 @@ MAP_ERROR_CODE set_node_list(const MAP_ParameterType_t* p_type, MAP_InputType_t if (next==0) { next++; } else if (next==1) { - if (biseqcstrcaseless(parsed->entry[i_parsed],"FIX")) { + if (biseqcstrcaseless(parsed->entry[i_parsed],"FIX") || biseqcstrcaseless(parsed->entry[i_parsed],"FIXED")) { node_iter->type = FIX; fix_num++; /* VarTypePtr FAST derived array index */ success = associate_vartype_ptr(&node_iter->position_ptr.x, other_type->x, fix_num); diff --git a/modules/moordyn/CMakeLists.txt b/modules/moordyn/CMakeLists.txt index 18f66807b8..a2608c7b2a 100644 --- a/modules/moordyn/CMakeLists.txt +++ b/modules/moordyn/CMakeLists.txt @@ -20,7 +20,12 @@ endif() set(MOORDYN_LIBS_SOURCES src/MoorDyn.f90 + src/MoorDyn_Body.f90 src/MoorDyn_IO.f90 + src/MoorDyn_Line.f90 + src/MoorDyn_Misc.f90 + src/MoorDyn_Point.f90 + src/MoorDyn_Rod.f90 src/MoorDyn_Types.f90 ) @@ -41,3 +46,4 @@ install(TARGETS moordyn_driver RUNTIME DESTINATION bin LIBRARY DESTINATION lib ARCHIVE DESTINATION lib) + diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 23d8854ef0..44f3a4f5fe 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -1,6 +1,7 @@ !********************************************************************************************************************************** ! LICENSING -! Copyright (C) 2015 Matthew Hall +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall ! ! This file is part of MoorDyn. ! @@ -22,19 +23,32 @@ MODULE MoorDyn USE MoorDyn_Types USE MoorDyn_IO USE NWTC_Library + USE MoorDyn_Line + USE MoorDyn_Point + USE MoorDyn_Rod + 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', '', '' ) + TYPE(ProgDesc), PARAMETER :: MD_ProgDesc = ProgDesc( 'MoorDyn', 'v2.a27', '2022-07-20' ) + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output PUBLIC :: MD_Init PUBLIC :: MD_UpdateStates PUBLIC :: MD_CalcOutput PUBLIC :: MD_CalcContStateDeriv PUBLIC :: MD_End + PUBLIC :: MD_JacobianPContState + PUBLIC :: MD_JacobianPInput + PUBLIC :: MD_JacobianPDiscState + PUBLIC :: MD_JacobianPConstrState + PUBLIC :: MD_GetOP CONTAINS @@ -43,7 +57,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er IMPLICIT NONE - TYPE(MD_InitInputType), INTENT(INOUT) :: InitInp ! INTENT(INOUT) : Input data for initialization routine + TYPE(MD_InitInputType), INTENT(IN ) :: InitInp ! INTENT(INOUT) : Input data for initialization routine TYPE(MD_InputType), INTENT( OUT) :: u ! INTENT( OUT) : An initial guess for the input; input mesh must be defined TYPE(MD_ParameterType), INTENT( OUT) :: p ! INTENT( OUT) : Parameters TYPE(MD_ContinuousStateType), INTENT( OUT) :: x ! INTENT( OUT) : Initial continuous states @@ -53,32 +67,94 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er TYPE(MD_OutputType), INTENT( OUT) :: y ! INTENT( OUT) : Initial system outputs (outputs are not calculated; only the output mesh is initialized) TYPE(MD_MiscVarType), INTENT( OUT) :: m ! INTENT( OUT) : Initial misc/optimization variables REAL(DbKi), INTENT(INOUT) :: DTcoupling ! Coupling interval in seconds: the rate that Output is the actual coupling interval - TYPE(MD_InitOutputType), INTENT(INOUT) :: InitOut ! Output for initialization routine + TYPE(MD_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(MD_InputFileType) :: InputFileDat ! Data read from input file for setup, but not stored after Init + type(FileInfoType) :: FileInfo_In !< The derived type for holding the full input file for parsing -- we may pass this in the future + ! CHARACTER(1024) :: priPath ! The path to the primary MoorDyn input file REAL(DbKi) :: t ! instantaneous time, to be used during IC generation - INTEGER(IntKi) :: I ! index + INTEGER(IntKi) :: l ! index + INTEGER(IntKi) :: I ! Current line number of input file INTEGER(IntKi) :: J ! index INTEGER(IntKi) :: K ! index + INTEGER(IntKi) :: Itemp ! index + 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) :: Pos(3) ! array for setting absolute fairlead positions in mesh - REAL(DbKi) :: TransMat(3,3) ! rotation matrix for setting fairlead positions correctly if there is initial platform rotation - REAL(DbKi), ALLOCATABLE :: FairTensIC(:,:)! array of size Nfairs, 3 to store three latest fairlead tensions of each line + 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 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 - TYPE(MD_InputType) :: uArray(1) ! a size-one array for u to make call to TimeStep happy - REAL(DbKi) :: utimes(1) ! a size-one array saying time is 0 to make call to TimeStep happy + 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 + + 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 + TYPE(MD_InputType) :: u_interp ! interpolated instantaneous input values to be calculated for each mooring time step + + CHARACTER(MaxWrScrLen) :: Message + + ! 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 + + 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 + CHARACTER(40) :: OptValue ! String to temporarially hold value of options variable input + CHARACTER(40) :: DepthValue ! Temporarily stores the optional WtrDpth setting for MD, which could be a number or a filename + CHARACTER(40) :: WaterKinValue ! Temporarily stores the optional WaterKin setting for MD, which is typically a filename + INTEGER(IntKi) :: nOpts ! number of options lines in input file + CHARACTER(40) :: TempString1 ! + CHARACTER(40) :: TempString2 ! + CHARACTER(40) :: TempString3 ! + CHARACTER(40) :: TempString4 ! + CHARACTER(40) :: TempString5 ! + CHARACTER(40) :: TempStrings(6) ! Array of 6 strings used when parsing comma-separated items + 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) + + + CHARACTER(25) :: let1 ! strings used for splitting and parsing identifiers + CHARACTER(25) :: num1 + CHARACTER(25) :: let2 + CHARACTER(25) :: num2 + CHARACTER(25) :: let3 + + REAL(DbKi) :: tempArray(6) + REAL(ReKi) :: rRef(6) ! used to pass positions to mesh (real type precision) + REAL(DbKi) :: rRefDub(3) + + INTEGER(IntKi) :: TempIDnums(100) ! array to hold IdNums of controlled lines for each CtrlChan + + ! for reading output channels + CHARACTER(ChanLen),ALLOCATABLE :: OutList(:) ! array of output channel request (moved here from InitInput) + INTEGER :: MaxAryLen = 1000 ! Maximum length of the array being read + INTEGER :: NumWords ! Number of words contained on a line + INTEGER :: Nx + INTEGER :: QuoteCh ! Character position. + CHARACTER(*), PARAMETER :: RoutineName = 'MD_Init' + ErrStat = ErrID_None ErrMsg = "" + m%zeros6 = 0.0_DbKi ! Initialize the NWTC Subroutine Library CALL NWTC_Init( ) @@ -87,422 +163,2082 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL DispNVD( MD_ProgDesc ) InitOut%Ver = MD_ProgDesc + CALL WrScr(' This is an alpha version of MoorDyn-F v2, with significant input file changes from v1.') + CALL WrScr(' Copyright: (C) 2021 National Renewable Energy Laboratory, (C) 2019 Matt Hall') + !--------------------------------------------------------------------------------------------- ! Get all the inputs taken care of !--------------------------------------------------------------------------------------------- - - ! set environmental parameters from input data and error check - ! (should remove these values as options from MoorDyn input file for consistency?) - - p%g = InitInp%g - p%WtrDpth = InitInp%WtrDepth - p%rhoW = InitInp%rhoW - p%RootName = TRIM(InitInp%RootName)//'.MD' ! all files written from this module will have this root name + ! set default values for the simulation settings + ! these defaults are based on the glue code + p%dtM0 = DTcoupling ! default to the coupling interval (but will likely need to be smaller) + p%Tmax = InitInp%Tmax + p%g = InitInp%g + p%rhoW = InitInp%rhoW + ! TODO: add MSL2SWL from OpenFAST <<<< + ! set the following to some defaults + p%kBot = 3.0E6 + p%cBot = 3.0E5 + InputFileDat%dtIC = 2.0_DbKi + InputFileDat%TMaxIC = 60.0_DbKi + InputFileDat%CdScaleIC = 4.0_ReKi + InputFileDat%threshIC = 0.01_ReKi + p%WaveKin = 0_IntKi + p%Current = 0_IntKi + p%dtOut = 0.0_DbKi + p%mu_kT = 0.0_DbKi + p%mu_kA = 0.0_DbKi + p%mc = 1.0_DbKi + p%cv = 200.0_DbKi + DepthValue = "" ! Start off as empty string, to only be filled if MD setting is specified (otherwise InitInp%WtrDepth is used) + ! DepthValue and InitInp%WtrDepth are processed later by setupBathymetry. + WaterKinValue = "" + + m%PtfmInit = InitInp%PtfmInit(:,1) ! is this copying necssary in case this is an individual instance in FAST.Farm? - ! call function that reads input file and creates cross-referenced Connect and Line objects - CALL MDIO_ReadInput(InitInp, p, m, ErrStat2, ErrMsg2) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - - ! process the OutList array and set up the index arrays for the requested output quantities - CALL MDIO_ProcessOutList(InitInp%OutList, p, m, y, InitOut, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - !------------------------------------------------------------------------------------------------- - ! Connect mooring system together and make necessary allocations - !------------------------------------------------------------------------------------------------- + ! 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 + p%nTurbines = 1 ! if a regular FAST module mode, we treat it like a nTurbine=1 farm case + END IF - CALL WrNR( ' Creating mooring system. ' ) + ! allocate some parameter arrays that are for each turbine (size 1 if regular OpenFAST use) + allocate( p%nCpldBodies( p%nTurbines)) + allocate( p%nCpldRods ( p%nTurbines)) + allocate( p%nCpldCons ( p%nTurbines)) + allocate( p%TurbineRefPos(3, p%nTurbines)) + + ! initialize the arrays (to zero, except for passed in farm turbine reference positions) + p%nCpldBodies = 0 + p%nCpldRods = 0 + p%nCpldCons = 0 + + if (InitInp%FarmSize > 0) then + p%TurbineRefPos = InitInp%TurbineRefPos ! copy over turbine reference positions for later use + else + p%TurbineRefPos = 0.0_DbKi ! for now assuming this is zero for FAST use + end if - p%NFairs = 0 ! this is the number of "vessel" type Connections. being consistent with MAP terminology - p%NConns = 0 ! this is the number of "connect" type Connections. not to be confused with NConnects, the number of Connections - p%NAnchs = 0 ! this is the number of "fixed" type Connections. + + !--------------------------------------------------------------------------------------------- + ! read input file and create cross-referenced mooring system objects + !--------------------------------------------------------------------------------------------- + + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" - ! cycle through Connects and identify Connect types - DO I = 1, p%NConnects - - TempString = m%ConnectList(I)%type - CALL Conv2UC(TempString) - if (TempString == 'FIXED') then - m%ConnectList(I)%TypeNum = 0 - p%NAnchs = p%NAnchs + 1 - else if (TempString == 'VESSEL') then - m%ConnectList(I)%TypeNum = 1 - p%NFairs = p%NFairs + 1 ! if a vessel connection, increment fairlead counter - else if (TempString == 'CONNECT') then - m%ConnectList(I)%TypeNum = 2 - p%NConns = p%NConns + 1 - else - CALL CheckError( ErrID_Fatal, 'Error in provided Connect type. Must be fixed, vessel, or connect.' ) - RETURN - END IF - END DO - CALL WrScr(trim(Num2LStr(p%NFairs))//' fairleads, '//trim(Num2LStr(p%NAnchs))//' anchors, '//trim(Num2LStr(p%NConns))//' connects.') + CALL WrScr( ' Parsing MoorDyn input file: '//trim(InitInp%FileName) ) - ! allocate fairleads list - ALLOCATE ( m%FairIdList(p%NFairs), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - CALL CheckError( ErrID_Fatal, 'Error allocating space for FairIdList array.') - RETURN - END IF + ! ----------------------------------------------------------------- + ! 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; - ! allocate connect list - ALLOCATE ( m%ConnIdList(p%NConns), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - CALL CheckError( ErrID_Fatal, 'Error allocating space for ConnIdList array.') - RETURN - END IF + ! 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; - ! now go back through and record the fairlead Id numbers (this is all the "connecting" that's required) - J = 1 ! counter for fairlead number - K = 1 ! counter for connect number - DO I = 1,p%NConnects - IF (m%ConnectList(I)%TypeNum == 1) THEN - m%FairIdList(J) = I ! if a vessel connection, add ID to list - J = J + 1 - ELSE IF (m%ConnectList(I)%TypeNum == 2) THEN - m%ConnIdList(K) = I ! if a connect connection, add ID to list - K = K + 1 - END IF - END DO - ! go through lines and allocate variables - DO I = 1, p%NLines - CALL SetupLine( m%LineList(I), m%LineTypeList(m%LineList(I)%PropsIdNum), p%rhoW , ErrStat2, ErrMsg2) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - END DO +!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. + !------------------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------ - ! prepare state vector - !------------------------------------------------------------------------------------ + UnEc = -1 + nOpts = 0 ! Setting here rather than implied save - ! allocate list of starting state vector indices for each line - does this belong elsewhere? - ALLOCATE ( m%LineStateIndList(p%NLines), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - CALL CheckError(ErrID_Fatal, ' Error allocating LineStateIndList array.') - RETURN - END IF + ! ----------------- go through file contents a first time, counting each entry ----------------------- - ! figure out required size of state vector and how it will be apportioned to Connect and Lines (J is keeping track of the growing size of the state vector) - J = p%NConns*6 ! start index of first line's states (added six state variables for each "connect"-type connection) + i = 0 ! set line number counter to before first line + Line = NextLine(i); ! Get the line and increment counter. See description of routine. + + do while ( i <= FileInfo_In%NumLines ) - DO I = 1, p%NLines - m%LineStateIndList(I) = J+1 ! assign start index of each line - J = J + 6*(m%LineList(I)%N - 1) !add 6 state variables for each internal node - END DO + if (INDEX(Line, "---") > 0) then ! look for a header line + if ( ( INDEX(Line, "LINE DICTIONARY") > 0) .or. ( INDEX(Line, "LINE TYPES") > 0) ) then ! if line dictionary header - ! allocate state vector for RK2 based on size just calculated - ALLOCATE ( x%states(J), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating state vector.' - !CALL CleanUp() - RETURN - END IF + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nLineTypes = p%nLineTypes + 1 + Line = NextLine(i) + END DO + else if ( (INDEX(Line, "ROD DICTIONARY") > 0) .or. ( INDEX(Line, "ROD TYPES") > 0) ) then ! if rod dictionary header - ! get header information for the FAST output file <<< what does this mean? + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nRodTypes = p%nRodTypes + 1 + Line = NextLine(i) + END DO + else if ((INDEX(Line, "BODIES") > 0 ) .or. (INDEX(Line, "BODY LIST") > 0 ) .or. (INDEX(Line, "BODY PROPERTIES") > 0 )) then - !-------------------------------------------------------------------------- - ! create i/o meshes for fairlead positions and forces - !-------------------------------------------------------------------------- + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nBodies = p%nBodies + 1 + Line = NextLine(i) + END DO - ! create input mesh for fairlead kinematics - CALL MeshCreate(BlankMesh=u%PtFairleadDisplacement , & - IOS= COMPONENT_INPUT , & - Nnodes=p%NFairs , & - TranslationDisp=.TRUE. , & - TranslationVel=.TRUE. , & - ErrStat=ErrStat2 , & - ErrMess=ErrMsg2) + else if ((INDEX(Line, "RODS") > 0 ) .or. (INDEX(Line, "ROD LIST") > 0) .or. (INDEX(Line, "ROD PROPERTIES") > 0)) then ! if rod properties header - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nRods = p%nRods + 1 + Line = NextLine(i) + END DO + else if ((INDEX(Line, "POINTS") > 0 ) .or. (INDEX(Line, "CONNECTION PROPERTIES") > 0) .or. (INDEX(Line, "NODE PROPERTIES") > 0) .or. (INDEX(Line, "POINT PROPERTIES") > 0) .or. (INDEX(Line, "POINT LIST") > 0) ) then ! if node properties header - ! --------------------------- set up initial condition of each fairlead ------------------------------- - DO i = 1,p%NFairs + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nConnects = p%nConnects + 1 + Line = NextLine(i) + END DO - Pos(1) = m%ConnectList(m%FairIdList(i))%conX ! set relative position of each fairlead i (I'm pretty sure this is just relative to ptfm origin) - Pos(2) = m%ConnectList(m%FairIdList(i))%conY - Pos(3) = m%ConnectList(m%FairIdList(i))%conZ + else if ((INDEX(Line, "LINES") > 0 ) .or. (INDEX(Line, "LINE PROPERTIES") > 0) .or. (INDEX(Line, "LINE LIST") > 0) ) then ! if line properties header - CALL MeshPositionNode(u%PtFairleadDisplacement,i,Pos,ErrStat2,ErrMsg2)! "assign the coordinates of each node in the global coordinate space" + ! skip following two lines (label line and unit line) + i=i+2 + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nLines = p%nLines + 1 + Line = NextLine(i) + END DO - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + else if (INDEX(Line, "CONTROL") > 0) then ! if failure conditions header + IF (wordy > 1) print *, " Reading control channels: "; + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nCtrlChans = p%nCtrlChans + 1 + Line = NextLine(i) + END DO + + else if (INDEX(Line, "FAILURE") > 0) then ! if failure conditions header - ! set offset position of each node to according to initial platform position - CALL SmllRotTrans('initial fairlead positions due to platform rotation', InitInp%PtfmInit(4),InitInp%PtfmInit(5),InitInp%PtfmInit(6), TransMat, '', ErrStat2, ErrMsg2) ! account for possible platform rotation + IF (wordy > 1) print *, " Reading failure conditions: "; + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nFails = p%nFails + 1 + Line = NextLine(i) + END DO + + + else if (INDEX(Line, "OPTIONS") > 0) then ! if options header - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + IF (wordy > 0) print *, "Reading Options" + + ! don't skip any lines (no column headers for the options section) + ! process each line in this section + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + + ! parse out entries: value, option keyword + READ(Line,*,IOSTAT=ErrStat2) OptValue, OptString ! look at first two entries, ignore remaining words in line, which should be comments + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to read options.', ErrStat, ErrMsg, RoutineName ) ! would be nice to specify which line had the error + CALL CleanUp() + RETURN + END IF + + CALL Conv2UC(OptString) + + ! check all possible options types and see if OptString is one of them, in which case set the variable. + if ( OptString == 'WRITELOG') THEN + read (OptValue,*) p%writeLog + if (p%writeLog > 0) then ! if not zero, open a log file for output + CALL GetNewUnit( p%UnLog ) + CALL OpenFOutFile ( p%UnLog, TRIM(p%RootName)//'.log', ErrStat, ErrMsg ) + IF ( ErrStat > AbortErrLev ) THEN + ErrMsg = ' Failed to open MoorDyn log file: '//TRIM(ErrMsg) + RETURN + 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." + end if + else if ( OptString == 'DTM') THEN + read (OptValue,*) p%dtM0 + else if ( OptString == 'G') then + read (OptValue,*) p%g + else if (( OptString == 'RHOW') .or. ( OptString == 'RHO')) then + read (OptValue,*) p%rhoW + else if (( OptString == 'WTRDPTH') .or. ( OptString == 'DEPTH') .or. ( OptString == 'WATERDEPTH')) then + read (OptValue,*) DepthValue ! water depth input read in as a string to be processed by setupBathymetry + else if (( OptString == 'KBOT') .or. ( OptString == 'KB')) then + read (OptValue,*) p%kBot + else if (( OptString == 'CBOT') .or. ( OptString == 'CB')) then + read (OptValue,*) p%cBot + else if ( OptString == 'DTIC') then + read (OptValue,*) InputFileDat%dtIC + else if ( OptString == 'TMAXIC') then + read (OptValue,*) InputFileDat%TMaxIC + else if ( OptString == 'CDSCALEIC') then + read (OptValue,*) InputFileDat%CdScaleIC + else if ( OptString == 'THRESHIC') then + read (OptValue,*) InputFileDat%threshIC + else if ( OptString == 'WATERKIN') then + read (OptValue,*) WaterKinValue + else if ( OptString == 'DTOUT') then + read (OptValue,*) p%dtOut + else if ( OptString == 'MU_KT') then + read (OptValue,*) p%mu_kT + else if ( OptString == 'MU_KA') then + read (OptValue,*) p%mu_kA + else if ( OptString == 'MC') then + read (OptValue,*) p%mc + else if ( OptString == 'CV') then + read (OptValue,*) p%cv + 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 + - ! Apply initial platform rotations and translations (fixed Jun 19, 2015) - u%PtFairleadDisplacement%TranslationDisp(1,i) = InitInp%PtfmInit(1) + Transmat(1,1)*Pos(1) + Transmat(2,1)*Pos(2) + TransMat(3,1)*Pos(3) - Pos(1) - u%PtFairleadDisplacement%TranslationDisp(2,i) = InitInp%PtfmInit(2) + Transmat(1,2)*Pos(1) + Transmat(2,2)*Pos(2) + TransMat(3,2)*Pos(3) - Pos(2) - u%PtFairleadDisplacement%TranslationDisp(3,i) = InitInp%PtfmInit(3) + Transmat(1,3)*Pos(1) + Transmat(2,3)*Pos(2) + TransMat(3,3)*Pos(3) - Pos(3) + else if (INDEX(Line, "OUTPUT") > 0) then ! if output header - ! set velocity of each node to zero - u%PtFairleadDisplacement%TranslationVel(1,i) = 0.0_DbKi - u%PtFairleadDisplacement%TranslationVel(2,i) = 0.0_DbKi - u%PtFairleadDisplacement%TranslationVel(3,i) = 0.0_DbKi - - !print *, 'Fairlead ', i, ' z TranslationDisp at start is ', u%PtFairleadDisplacement%TranslationDisp(3,i) - !print *, 'Fairlead ', i, ' z Position at start is ', u%PtFairleadDisplacement%Position(3,i) + ! we don't need to count this section... + Line = NextLine(i) - ! set each node as a point element - CALL MeshConstructElement(u%PtFairleadDisplacement, ELEMENT_POINT, ErrStat2, ErrMsg2, i) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + else ! otherwise ignore this line that isn't a recognized header line and read the next line + Line = NextLine(i) + end if - END DO ! I + else ! otherwise ignore this line, which doesn't have the "---" or header line and read the next line + Line = NextLine(i) + end if + + end do + p%nConnectsExtra = p%nConnects + 2*p%nLines ! set maximum number of connections, accounting for possible detachment of each line end and a connection for that - CALL MeshCommit ( u%PtFairleadDisplacement, ErrStat, ErrMsg ) + IF (wordy > 0) print *, " Identified ", p%nLineTypes , "LineTypes in input file." + IF (wordy > 0) print *, " Identified ", p%nRodTypes , "RodTypes in input file." + IF (wordy > 0) print *, " Identified ", p%nBodies , "Bodies in input file." + IF (wordy > 0) print *, " Identified ", p%nRods , "Rods in input file." + IF (wordy > 0) print *, " Identified ", p%nConnects , "Connections in input file." + IF (wordy > 0) print *, " Identified ", p%nLines , "Lines in input file." + IF (wordy > 0) print *, " Identified ", nOpts , "Options in input file." - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + ! set up seabed bathymetry + CALL setupBathymetry(DepthValue, InitInp%WtrDepth, m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, ErrStat2, ErrMsg2) + CALL getDepthFromBathymetry(m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, 0.0_DbKi, 0.0_DbKi, p%WtrDpth, nvec) ! set depth at 0,0 as nominal for waves etc + + + ! set up wave and current kinematics + CALL setupWaterKin(WaterKinValue, p, InitInp%Tmax, ErrStat2, ErrMsg2); if(Failed()) return - ! copy the input fairlead kinematics mesh to make the output mesh for fairlead loads, PtFairleadLoad - CALL MeshCopy ( SrcMesh = u%PtFairleadDisplacement, DestMesh = y%PtFairleadLoad, & - CtrlCode = MESH_SIBLING, IOS = COMPONENT_OUTPUT, & - Force = .TRUE., ErrStat = ErrStat2, ErrMess=ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + ! ----------------------------- misc checks to be sorted ----------------------------- - ! -------------------------------------------------------------------- - ! go through all Connects and set position based on input file - ! -------------------------------------------------------------------- - ! first do it for all connections (connect and anchor types will be saved) - DO I = 1, p%NConnects - m%ConnectList(I)%r(1) = m%ConnectList(I)%conX - m%ConnectList(I)%r(2) = m%ConnectList(I)%conY - m%ConnectList(I)%r(3) = m%ConnectList(I)%conZ - m%ConnectList(I)%rd(1) = 0.0_DbKi - m%ConnectList(I)%rd(2) = 0.0_DbKi - m%ConnectList(I)%rd(3) = 0.0_DbKi - END DO + ! make sure nLineTypes isn't zero + IF ( p%nLineTypes < 1 ) THEN + CALL SetErrStat( ErrID_Fatal, 'nLineTypes parameter must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! make sure NLines is at least one + IF ( p%NLines < 1 ) THEN + CALL SetErrStat( ErrID_Fatal, 'NLines parameter must be at least 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF - ! then do it for fairlead types - DO I = 1,p%NFairs - DO J = 1, 3 - m%ConnectList(m%FairIdList(I))%r(J) = u%PtFairleadDisplacement%Position(J,I) + u%PtFairleadDisplacement%TranslationDisp(J,I) - m%ConnectList(m%FairIdList(I))%rd(J) = 0.0_DbKi - END DO - END DO - ! for connect types, write the coordinates to the state vector - DO I = 1,p%NConns - x%states(6*I-2:6*I) = m%ConnectList(m%ConnIdList(I))%r ! double check order of r vs rd - x%states(6*I-5:6*I-3) = m%ConnectList(m%ConnIdList(I))%rd - END DO + + - ! -------------------------------------------------------------------- - ! open output file(s) and write header lines - CALL MDIO_OpenOutput( InitInp%FileName, p, m, InitOut, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - ! -------------------------------------------------------------------- + ! ----------------------------- allocate necessary arrays ---------------------------- + ! Allocate object arrays - ! -------------------------------------------------------------------- - ! size active tensioning inputs arrays based on highest channel number read from input file for now <<<<<<< - ! -------------------------------------------------------------------- + ALLOCATE(m%LineTypeList(p%nLineTypes), STAT = ErrStat2 ); if(AllocateFailed("LineTypeList")) return + ALLOCATE(m%RodTypeList( p%nRodTypes ), STAT = ErrStat2 ); if(AllocateFailed("LineTypeList")) return + + ALLOCATE(m%BodyList( p%nBodies ), STAT = ErrStat2 ); if(AllocateFailed("BodyList" )) return + ALLOCATE(m%RodList( p%nRods ), STAT = ErrStat2 ); if(AllocateFailed("RodList" )) return + ALLOCATE(m%ConnectList( p%nConnects ), STAT = ErrStat2 ); if(AllocateFailed("ConnectList" )) return + ALLOCATE(m%LineList( p%nLines ), STAT = ErrStat2 ); if(AllocateFailed("LineList" )) return - ! find the highest channel number - N = 0 - DO I = 1, p%NLines - IF ( m%LineList(I)%CtrlChan > N ) then - N = m%LineList(I)%CtrlChan - END IF - END DO + ALLOCATE(m%FailList( p%nFails ), STAT = ErrStat2 ); if(AllocateFailed("FailList" )) return + - ! allocate the input arrays (if any requested) - if (N > 0) then - call AllocAry( u%DeltaL, N, 'u%DeltaL', ErrStat2, ErrMsg2 ) - call CheckError( ErrStat2, ErrMsg2 ) - if (ErrStat >= AbortErrLev) return - u%DeltaL = 0.0_ReKi - call AllocAry( u%DeltaLdot, N, 'u%DeltaLdot', ErrStat2, ErrMsg2 ) - call CheckError( ErrStat2, ErrMsg2 ) - if (ErrStat >= AbortErrLev) return - u%DeltaLdot = 0.0_ReKi - call AllocAry( InitOut%CableCChanRqst, N, 'CableCChanRqst', ErrStat2, ErrMsg2 ) - call CheckError( ErrStat2, ErrMsg2 ) - if (ErrStat >= AbortErrLev) return - InitOut%CableCChanRqst = .FALSE. ! Initialize to false - do J=1,p%NLines - if (m%LineList(J)%CtrlChan > 0) InitOut%CableCChanRqst(m%LineList(J)%CtrlChan) = .TRUE. - enddo - endif + ! 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%ConStateIs1(p%nConnects), m%ConStateIsN(p%nConnects), STAT=ErrStat2); if(AllocateFailed("ConStateIs1/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%FreeConIs( p%nConnects), STAT=ErrStat2); if(AllocateFailed("FreeConnectIs")) return - ! -------------------------------------------------------------------- - ! go through lines and initialize internal node positions using Catenary() - ! -------------------------------------------------------------------- - DO I = 1, p%NLines - - N = m%LineList(I)%N ! for convenience - - !TODO: apply any initial adjustment of line length from active tensioning <<<<<<<<<<<< - ! >>> maybe this should be skipped <<<< - - ! set end node positions and velocities from connect objects - m%LineList(I)%r(:,N) = m%ConnectList(m%LineList(I)%FairConnect)%r - m%LineList(I)%r(:,0) = m%ConnectList(m%LineList(I)%AnchConnect)%r - m%LineList(I)%rd(:,N) = (/ 0.0, 0.0, 0.0 /) ! set anchor end velocities to zero - m%LineList(I)%rd(:,0) = (/ 0.0, 0.0, 0.0 /) ! set fairlead end velocities to zero + 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%CpldConIs(p%nConnects, p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldConnectIs")) return - ! set initial line internal node positions using quasi-static model or straight-line interpolation from anchor to fairlead - CALL InitializeLine( m%LineList(I), m%LineTypeList(m%LineList(I)%PropsIdNum), p%rhoW , ErrStat2, ErrMsg2) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - IF (ErrStat >= ErrId_Warn) CALL WrScr(" Catenary solver failed for one or more lines. Using linear node spacing.") ! make this statement more accurate - ! assign the resulting internal node positions to the integrator initial state vector! (velocities leave at 0) - DO J = 1, N-1 - DO K = 1, 3 - x%states(m%LineStateIndList(I) + 3*N-3 + 3*J-3 + K-1 ) = m%LineList(I)%r(K,J) ! assign position - x%states(m%LineStateIndList(I) + 3*J-3 + K-1 ) = 0.0_DbKi ! assign velocities (of zero) - END DO - END DO + ! ---------------------- now go through again and process file contents -------------------- - END DO !I = 1, p%NLines + call Body_Setup( m%GroundBody, m%zeros6, p, ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + ! note: no longer worrying about "Echo" option + + Nx = 0 ! set state counter to zero + i = 0 ! set line number counter to before first line + Line = NextLine(i) + + do while ( i <= FileInfo_In%NumLines ) + + if (INDEX(Line, "---") > 0) then ! look for a header line + + CALL Conv2UC(Line) ! allow lowercase section header names as well -! ! try writing output for troubleshooting purposes (TEMPORARY) -! CALL MDIO_WriteOutputs(-1.0_DbKi, p, m, y, ErrStat, ErrMsg) -! IF ( ErrStat >= AbortErrLev ) THEN -! ErrMsg = ' Error in MDIO_WriteOutputs: '//TRIM(ErrMsg) -! RETURN -! END IF + !------------------------------------------------------------------------------------------- + if ( ( INDEX(Line, "LINE DICTIONARY") > 0) .or. ( INDEX(Line, "LINE TYPES") > 0) ) then ! if line dictionary header + + IF (wordy > 0) print *, "Reading line types" + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each line + DO l = 1,p%nLineTypes + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + IF ( CountWords( Line ) /= 10 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse Line type '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 10 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! parse out entries: Name Diam MassDenInAir EA cIntDamp EI Cd Ca CdAx CaAx + READ(Line,*,IOSTAT=ErrStat2) m%LineTypeList(l)%name, m%LineTypeList(l)%d, & + m%LineTypeList(l)%w, tempString1, tempString2, tempString3, & + m%LineTypeList(l)%Cdn, m%LineTypeList(l)%Can, m%LineTypeList(l)%Cdt, m%LineTypeList(l)%Cat + + IF ( ErrStat2 /= ErrID_None ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to process line type inputs of entry '//trim(Num2LStr(l))//'. Check formatting and correct number of columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + !TODO: add check if %name is maximum length, which might indicate the full name was too long <<< + + ! 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 ) + CALL CleanUp() + else if (N==2) then ! visco-elastic case! + m%LineTypeList(l)%ElasticMod = 2 + read(tempStrings(2), *) m%LineTypeList(l)%EA_D + else + m%LineTypeList(l)%ElasticMod = 1 ! normal case + 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)%EA, & + m%LineTypeList(l)%nEApoints, & + m%LineTypeList(l)%stiffXs, & + m%LineTypeList(l)%stiffYs, ErrStat2, ErrMsg2) + + + ! 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 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)? + CALL WrScr("Warning, viscoelastic model being used with zero damping on the dynamic stiffness.") + 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, & + m%LineTypeList(l)%nBApoints, & + m%LineTypeList(l)%dampXs, & + m%LineTypeList(l)%dampYs, ErrStat2, ErrMsg2) + + ! process bending stiffness coefficients (which might use lookup tables) + CALL getCoefficientOrCurve(tempString3, m%LineTypeList(l)%EI, & + m%LineTypeList(l)%nEIpoints, & + m%LineTypeList(l)%bstiffXs, & + m%LineTypeList(l)%bstiffYs, ErrStat2, ErrMsg2) + + ! specify IdNum of line type for error checking + 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 ( ErrStat2 /= ErrID_None ) THEN + CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + END DO - ! -------------------------------------------------------------------- - ! do dynamic relaxation to get ICs - ! -------------------------------------------------------------------- - CALL WrScr(" Finalizing ICs using dynamic relaxation."//NewLine) ! newline because next line writes over itself + !------------------------------------------------------------------------------------------- + else if ( (INDEX(Line, "ROD DICTIONARY") > 0) .or. ( INDEX(Line, "ROD TYPES") > 0) ) then ! if rod dictionary header + + IF (wordy > 0) print *, "Reading rod types" + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each line + DO l = 1,p%nRodTypes + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + 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 + 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)%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 + 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 + end if + + IF ( ErrStat2 /= ErrID_None ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to process rod type properties for rod '//trim(Num2LStr(l))//'. Check formatting and correct number of columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + END DO + + + !------------------------------------------------------------------------------------------- + else if ((INDEX(Line, "BODIES") > 0 ) .or. (INDEX(Line, "BODY LIST") > 0 ) .or. (INDEX(Line, "BODY PROPERTIES") > 0 )) then + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each body + DO l = 1,p%nBodies + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + IF ( CountWords( Line ) /= 14 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse Body '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 14 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF - ! boost drag coefficient of each line type - DO I = 1, p%NTypes - m%LineTypeList(I)%Cdn = m%LineTypeList(I)%Cdn * InitInp%CdScaleIC - m%LineTypeList(I)%Cdt = m%LineTypeList(I)%Cdt * InitInp%CdScaleIC - END DO + ! parse out entries: ID Attachment X0 Y0 Z0 r0 p0 y0 M CG* I* V CdA* Ca* + IF (ErrStat2 == 0) THEN + READ(Line,*,IOSTAT=ErrStat2) m%BodyList(l)%IdNum, tempString1, & + tempArray(1), tempArray(2), tempArray(3), tempArray(4), tempArray(5), tempArray(6), & + m%BodyList(l)%bodyM, tempString2, tempString3, m%BodyList(l)%bodyV, tempString4, tempString5 + END IF + + ! process CG + CALL SplitByBars(tempString2, N, tempStrings) + if (N == 1) then ! if only one entry, it is the z coordinate + m%BodyList(l)%rCG(1) = 0.0_DbKi + m%BodyList(l)%rCG(2) = 0.0_DbKi + READ(tempString2, *) m%BodyList(l)%rCG(3) + else if (N==3) then ! all three coordinates provided + READ(tempStrings(1), *) m%BodyList(l)%rCG(1) + READ(tempStrings(2), *) m%BodyList(l)%rCG(2) + READ(tempStrings(3), *) m%BodyList(l)%rCG(3) + 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 + 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) + m%BodyList(l)%BodyI(2) = m%BodyList(l)%BodyI(1) + m%BodyList(l)%BodyI(3) = m%BodyList(l)%BodyI(1) + else if (N==3) then ! all three directions provided separately + READ(tempStrings(1), *) m%BodyList(l)%BodyI(1) + READ(tempStrings(2), *) m%BodyList(l)%BodyI(2) + READ(tempStrings(3), *) m%BodyList(l)%BodyI(3) + else + CALL SetErrStat( ErrID_Fatal, 'Body '//trim(Num2LStr(l))//' inertia entry (col 11) must have 1 or 3 numbers.' , ErrStat, ErrMsg, RoutineName ) + end if + ! process drag ceofficient by area product + CALL SplitByBars(tempString4, N, tempStrings) + if (N == 1) then ! if only one entry, use it for all directions + 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) + 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) + else + CALL SetErrStat( ErrID_Fatal, 'Body '//trim(Num2LStr(l))//' CdA entry (col 13) must have 1 or 3 numbers.' , ErrStat, ErrMsg, RoutineName ) + end if + ! process added mass coefficient + CALL SplitByBars(tempString5, N, tempStrings) + if (N == 1) then ! if only one entry, use it for all directions + READ(tempString5, *) m%BodyList(l)%BodyCa(1) + m%BodyList(l)%BodyCa(2) = m%BodyList(l)%BodyCa(1) + m%BodyList(l)%BodyCa(3) = m%BodyList(l)%BodyCa(1) + else if (N==3) then ! all three coordinates provided + READ(tempStrings(1), *) m%BodyList(l)%BodyCa(1) + READ(tempStrings(2), *) m%BodyList(l)%BodyCa(2) + READ(tempStrings(3), *) m%BodyList(l)%BodyCa(3) + else + CALL SetErrStat( ErrID_Fatal, 'Body '//trim(Num2LStr(l))//' Ca entry (col 14) must have 1 or 3 numbers.' , ErrStat, ErrMsg, RoutineName ) + end if + + + IF ( ErrStat2 /= 0 ) THEN + 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 ) + CALL CleanUp() + RETURN + END IF + - ! allocate array holding three latest fairlead tensions - ALLOCATE ( FairTensIC(p%NFairs,3), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - CALL CheckError( ErrID_Fatal, ErrMsg2 ) - RETURN - END IF + !----------- process body type ----------------- - ! initialize fairlead tension memory at zero - DO J = 1,p%NFairs - DO I = 1, 3 - FairTensIC(J,I) = 0.0_DbKi - END DO - END DO + call DecomposeString(tempString1, let1, num1, let2, num2, let3) ! note: this call is overkill (it's just a string) but leaving it here for potential future expansions + + if ((let1 == "ANCHOR") .or. (let1 == "FIXED") .or. (let1 == "FIX")) then ! if a fixed body (this would just be used if someone wanted to temporarly fix a body that things were attached to) + + m%BodyList(l)%typeNum = 1 + + else if ((let1 == "COUPLED") .or. (let1 == "VESSEL") .or. (let1 == "CPLD") .or. (let1 == "VES")) then ! if a coupled body + + m%BodyList(l)%typeNum = -1 + p%nCpldBodies(1)=p%nCpldBodies(1)+1 ! add this body to coupled list + m%CpldBodyIs(p%nCpldBodies(1),1) = l - t = 0.0_DbKi ! start time at zero + ! body initial position due to coupling will be adjusted later + + ! TODO: add option for body coupling to different turbines in FAST.Farm <<< + + else if (let1 == "FREE") then ! if a free body + m%BodyList(l)%typeNum = 0 + + p%nFreeBodies=p%nFreeBodies+1 + + m%BodyStateIs1(p%nFreeBodies) = Nx+1 + m%BodyStateIsN(p%nFreeBodies) = Nx+12 + Nx = Nx + 12 ! add 12 state variables for free Body + + m%FreeBodyIs(p%nFreeBodies) = l + + m%BodyList(l)%r6 = tempArray ! set initial body position and orientation + + else + CALL SetErrStat( ErrID_Fatal, "Unidentified Body type string for Body "//trim(Num2LStr(l))//": "//trim(tempString1), ErrStat, ErrMsg, RoutineName ) + return + end if + + + ! check for sequential IdNums + IF ( m%BodyList(l)%IdNum .NE. l ) THEN + CALL SetErrStat( ErrID_Fatal, 'Body numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + + ! set up body + CALL Body_Setup( m%BodyList(l), tempArray, p, ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to read data for body '//trim(Num2LStr(l)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + IF (wordy > 1) print *, "Set up body ", l, " of type ", m%BodyList(l)%typeNum - ! because TimeStep wants an array... - call MD_CopyInput( u, uArray(1), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + END DO + + + !------------------------------------------------------------------------------------------- + else if ((INDEX(Line, "RODS") > 0 ) .or. (INDEX(Line, "ROD LIST") > 0) .or. (INDEX(Line, "ROD PROPERTIES") > 0)) then ! if rod properties header + IF (wordy > 0) print *, "Reading Rods" + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each rod + DO l = 1,p%nRods + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + IF ( CountWords( Line ) /= 11 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse Rod '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 11 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! parse out entries: RodID RodType Attachment Xa Ya Za Xb Yb Zb NumSegs Flags/Outputs + IF (ErrStat2 == 0) THEN + READ(Line,*,IOSTAT=ErrStat2) m%RodList(l)%IdNum, tempString1, tempString2, & + tempArray(1), tempArray(2), tempArray(3), tempArray(4), tempArray(5), tempArray(6), & + m%RodList(l)%N, LineOutString + END IF - DO I = 1, ceiling(InitInp%TMaxIC/InitInp%DTIC) ! loop through IC gen time steps, up to maximum + ! find Rod properties index + DO J = 1,p%nRodTypes + IF (trim(tempString1) == trim(m%RodTypeList(J)%name)) THEN + m%RodList(l)%PropsIdNum = J + EXIT + END IF + IF (J == p%nRodTypes) THEN ! call an error if there is no match + CALL SetErrStat( ErrID_Fatal, 'Unable to find matching rod type name for Rod '//trim(Num2LStr(l))//": "//trim(tempString1), ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + END DO - ! integrate the EOMs one DTIC s time step - CALL TimeStep ( t, InitInp%DTIC, uArray, utimes, p, x, xd, z, other, m, ErrStat, ErrMsg ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - ! store new fairlead tension (and previous fairlead tensions for comparison) - DO J = 1, p%NFairs - FairTensIC(J,3) = FairTensIC(J,2) - FairTensIC(J,2) = FairTensIC(J,1) - FairTensIC(J,1) = TwoNorm(m%ConnectList(m%FairIdList(J))%Ftot(:)) - END DO + !----------- process rod type ----------------- - ! provide status message - ! bjj: putting this in a string so we get blanks to cover up previous values (if current string is shorter than previous one) - Message = ' t='//trim(Num2LStr(t))//' FairTen 1: '//trim(Num2LStr(FairTensIC(1,1)))// & - ', '//trim(Num2LStr(FairTensIC(1,2)))//', '//trim(Num2LStr(FairTensIC(1,3))) - CALL WrOver( Message ) - - ! check for convergence (compare current tension at each fairlead with previous two values) - IF (I > 2) THEN - Converged = 1 - DO J = 1, p%NFairs ! check for non-convergence - IF (( abs( FairTensIC(J,1)/FairTensIC(J,2) - 1.0 ) > InitInp%threshIC ) .OR. ( abs( FairTensIC(J,1)/FairTensIC(J,3) - 1.0 ) > InitInp%threshIC ) ) THEN - Converged = 0 - EXIT - END IF - END DO + call DecomposeString(tempString2, let1, num1, let2, num2, let3) + + if ((let1 == "ANCHOR") .or. (let1 == "FIXED") .or. (let1 == "FIX")) then + + m%RodList(l)%typeNum = 2 + CALL Body_AddRod(m%GroundBody, l, tempArray) ! add rod l to Ground body + - IF (Converged == 1) THEN ! (J == p%NFairs) THEN ! if we made it with all cases satisfying the threshold - CALL WrScr(' Fairlead tensions converged to '//trim(Num2LStr(100.0*InitInp%threshIC))//'% after '//trim(Num2LStr(t))//' seconds.') - EXIT ! break out of the time stepping loop - END IF - END IF + else if ((let1 == "PINNED") .or. (let1 == "PIN")) then + m%RodList(l)%typeNum = 1 + CALL Body_AddRod(m%GroundBody, l, tempArray) ! add rod l to Ground body + + p%nFreeRods=p%nFreeRods+1 ! add this pinned rod to the free list because it is half free + + m%RodStateIs1(p%nFreeRods) = Nx+1 + m%RodStateIsN(p%nFreeRods) = Nx+6 + Nx = Nx + 6 ! add 6 state variables for each pinned rod + + m%FreeRodIs(p%nFreeRods) = l + + else if (let1 == "BODY") then ! attached to a body (either rididly or pinned) + + if (len_trim(num1) > 0) then + + READ(num1,*) J ! convert to int, representing parent body index + + if ((J <= p%nBodies) .and. (J > 0)) then + + CALL Body_AddRod(m%BodyList(J), l, tempArray) ! add rod l to the body + + if ( (let2 == "PINNED") .or. (let2 == "PIN") ) then + m%RodList(l)%typeNum = 1 + + p%nFreeRods=p%nFreeRods+1 ! add this pinned rod to the free list because it is half free + + m%RodStateIs1(p%nFreeRods) = Nx+1 + m%RodStateIsN(p%nFreeRods) = Nx+6 + Nx = Nx + 6 ! add 6 state variables for each pinned rod + + m%FreeRodIs(p%nFreeRods) = l + + else if (let2 == " ") then ! rod is not requested to be pinned, so add this rod as a fixed one + m%RodList(l)%typeNum = 2 + + else + CALL SetErrStat( ErrID_Fatal, "Unidentified Type/BodyID for Rod "//trim(Num2LStr(l))//": "//trim(tempString2), ErrStat, ErrMsg, RoutineName ) + return + end if + + else + CALL SetErrStat( ErrID_Fatal, "Body 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))//" Body attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + else if ((let1 == "VESSEL") .or. (let1 == "VES") .or. (let1 == "COUPLED") .or. (let1 == "CPLD")) then ! if a rigidly coupled rod, add to list and add + m%RodList(l)%typeNum = -2 + + p%nCpldRods(1)=p%nCpldRods(1)+1 ! add this rod to coupled list + + m%CpldRodIs(p%nCpldRods(1),1) = l + + else if ((let1 == "VESSELPINNED") .or. (let1 == "VESPIN") .or. (let1 == "COUPLEDPINNED") .or. (let1 == "CPLDPIN")) then ! if a pinned coupled rod, add to list and add + m%RodList(l)%typeNum = -1 + + p%nCpldRods(1)=p%nCpldRods(1)+1 ! add + p%nFreeRods =p%nFreeRods+1 ! add this pinned rod to the free list because it is half free + + m%RodStateIs1(p%nFreeRods) = Nx+1 + m%RodStateIsN(p%nFreeRods) = Nx+6 + Nx = Nx + 6 ! add 6 state variables for each pinned rod + + 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 == "CONNECT") .or. (let1 == "CON") .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 + + m%RodStateIs1(p%nFreeRods) = Nx+1 + m%RodStateIsN(p%nFreeRods) = Nx+12 + Nx = Nx + 12 ! add 12 state variables for free Rod + + m%FreeRodIs(p%nFreeRods) = l + + else + + CALL SetErrStat( ErrID_Fatal, "Unidentified Type/BodyID for Rod "//trim(Num2LStr(l))//": "//trim(tempString2), ErrStat, ErrMsg, RoutineName ) + return + end if + + + ! process output flag characters (LineOutString) and set line output flag array (OutFlagList) + m%RodList(l)%OutFlagList = 0 ! first set array all to zero + ! per node, 3 component + IF ( scan( LineOutString, 'p') > 0 ) m%RodList(l)%OutFlagList(2 ) = 1 ! node position + IF ( scan( LineOutString, 'v') > 0 ) m%RodList(l)%OutFlagList(3 ) = 1 ! node velocity + IF ( scan( LineOutString, 'U') > 0 ) m%RodList(l)%OutFlagList(4 ) = 1 ! water velocity + IF ( scan( LineOutString, 'B') > 0 ) m%RodList(l)%OutFlagList(5 ) = 1 ! node buoyancy force + IF ( scan( LineOutString, 'D') > 0 ) m%RodList(l)%OutFlagList(6 ) = 1 ! drag force + IF ( scan( LineOutString, 'I') > 0 ) m%RodList(l)%OutFlagList(7 ) = 1 ! inertia force + IF ( scan( LineOutString, 'P') > 0 ) m%RodList(l)%OutFlagList(8 ) = 1 ! dynamic pressure force + IF ( scan( LineOutString, 'b') > 0 ) m%RodList(l)%OutFlagList(9 ) = 1 ! seabed contact forces + ! per node, 1 component + IF ( scan( LineOutString, 'W') > 0 ) m%RodList(l)%OutFlagList(10) = 1 ! node weight/buoyancy (positive up) + IF ( scan( LineOutString, 'K') > 0 ) m%RodList(l)%OutFlagList(11) = 1 ! curvature at node + ! per element, 1 component >>> these don't apply to a rod!! <<< + IF ( scan( LineOutString, 't') > 0 ) m%RodList(l)%OutFlagList(12) = 1 ! segment tension force (just EA) + IF ( scan( LineOutString, 'c') > 0 ) m%RodList(l)%OutFlagList(13) = 1 ! segment internal damping force + IF ( scan( LineOutString, 's') > 0 ) m%RodList(l)%OutFlagList(14) = 1 ! Segment strain + IF ( scan( LineOutString, 'd') > 0 ) m%RodList(l)%OutFlagList(15) = 1 ! Segment strain rate + + IF (SUM(m%RodList(l)%OutFlagList) > 0) m%RodList(l)%OutFlagList(1) = 1 ! this first entry signals whether to create any output file at all + ! the above letter-index combinations define which OutFlagList entry corresponds to which output type + + + ! specify IdNum of line for error checking + m%RodList(l)%IdNum = l + + ! check for sequential IdNums + IF ( m%RodList(l)%IdNum .NE. l ) THEN + CALL SetErrStat( ErrID_Fatal, 'Line numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! set up rod + CALL Rod_Setup( m%RodList(l), m%RodTypeList(m%RodList(l)%PropsIdNum), tempArray, p, ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + ! note: Rod was already added to its respective parent body if type > 0 + + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to read rod data for Rod '//trim(Num2LStr(l)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF - IF (I == ceiling(InitInp%TMaxIC/InitInp%DTIC) ) THEN - CALL WrScr(' Fairlead tensions did not converge within TMaxIC='//trim(Num2LStr(InitInp%TMaxIC))//' seconds.') - !ErrStat = ErrID_Warn - !ErrMsg = ' MD_Init: ran dynamic convergence to TMaxIC without convergence' - END IF + END DO ! l = 1,p%nRods - END DO ! I ... looping through time steps - CALL MD_DestroyInput( uArray(1), ErrStat2, ErrMsg2 ) + !------------------------------------------------------------------------------------------- + else if ((INDEX(Line, "POINTS") > 0 ) .or. (INDEX(Line, "CONNECTION PROPERTIES") > 0) .or. (INDEX(Line, "NODE PROPERTIES") > 0) .or. (INDEX(Line, "POINT PROPERTIES") > 0) .or. (INDEX(Line, "POINT LIST") > 0) ) then ! if node properties header + + IF (wordy > 0) print *, "Reading Points" + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each point + DO l = 1,p%nConnects + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + IF ( CountWords( Line ) /= 9 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse Point '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 9 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! parse out entries: PointID Attachment X Y Z M V CdA Ca + IF (ErrStat2 == 0) THEN + READ(Line,*,IOSTAT=ErrStat2) m%ConnectList(l)%IdNum, tempString1, tempArray(1), & + tempArray(2), tempString4, m%ConnectList(l)%conM, & + m%ConnectList(l)%conV, m%ConnectList(l)%conCdA, m%ConnectList(l)%conCa + + CALL Conv2UC(tempString4) ! convert to uppercase so that matching is not case-sensitive + + 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 + 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, + READ(tempString4, *, IOSTAT=ErrStat2) tempArray(3) ! assume it's a scalar depth value + !TODO: add error check for if the above read fails + end if + + ! not used + m%ConnectList(l)%conFX = 0.0_DbKi + m%ConnectList(l)%conFY = 0.0_DbKi + m%ConnectList(l)%conFZ = 0.0_DbKi + + END IF + + + IF ( ErrStat2 /= 0 ) THEN + 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 connects.' , ErrStat, ErrMsg, RoutineName ) ! would be nice to specify which line <<<<<<<<< + CALL CleanUp() + RETURN + END IF + + m%ConnectList(l)%r = tempArray(1:3) ! set initial, or reference, node position (for coupled or child objects, this will be the local reference location about the parent) - ! UNboost drag coefficient of each line type - DO I = 1, p%NTypes - m%LineTypeList(I)%Cdn = m%LineTypeList(I)%Cdn / InitInp%CdScaleIC - m%LineTypeList(I)%Cdt = m%LineTypeList(I)%Cdt / InitInp%CdScaleIC - END DO + !----------- process connection type ----------------- + call DecomposeString(tempString1, let1, num1, let2, num2, let3) + + if ((let1 == "ANCHOR") .or. (let1 == "FIXED") .or. (let1 == "FIX")) then + m%ConnectList(l)%typeNum = 1 + + !m%ConnectList(l)%r = tempArray(1:3) ! set initial node position + + CALL Body_AddConnect(m%GroundBody, l, tempArray(1:3)) ! add connection l to Ground body + + else if (let1 == "BODY") then ! attached to a body + if (len_trim(num1) > 0) then + READ(num1, *) J ! convert to int, representing parent body index + + if ((J <= p%nBodies) .and. (J > 0)) then + m%ConnectList(l)%typeNum = 1 + + CALL Body_AddConnect(m%BodyList(J), l, tempArray(1:3)) ! add connection l to Ground body + + else + CALL SetErrStat( ErrID_Fatal, "Body ID out of bounds for Connection "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) + return + end if + else + CALL SetErrStat( ErrID_Fatal, "No number provided for Connection "//trim(Num2LStr(l))//" Body attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + else if ((let1 == "VESSEL") .or. (let1 == "VES") .or. (let1 == "COUPLED") .or. (let1 == "CPLD")) then ! if a fairlead, add to list and add + m%ConnectList(l)%typeNum = -1 + p%nCpldCons(1)=p%nCpldCons(1)+1 + m%CpldConIs(p%nCpldCons(1),1) = l + + else if ((let1 == "CONNECT") .or. (let1 == "CON") .or. (let1 == "FREE")) then + m%ConnectList(l)%typeNum = 0 + + p%nFreeCons=p%nFreeCons+1 ! add this pinned rod to the free list because it is half free + + m%ConStateIs1(p%nFreeCons) = Nx+1 + m%ConStateIsN(p%nFreeCons) = Nx+6 + Nx = Nx + 6 ! add 12 state variables for free Connection + + m%FreeConIs(p%nFreeCons) = l + + !m%ConnectList(l)%r = tempArray(1:3) ! set initial node position + + 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%ConnectList(l)%TypeNum = -1 ! set as coupled type + p%nCpldCons(J) = p%nCpldCons(J) + 1 ! increment counter for the appropriate turbine + m%CpldConIs(p%nCpldCons(J),J) = l + CALL WrScr(' added connection '//TRIM(int2lstr(l))//' as fairlead for turbine '//trim(int2lstr(J))) + + + else + CALL SetErrStat( ErrID_Fatal, "Turbine ID out of bounds for Connection "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) + return + end if + else + CALL SetErrStat( ErrID_Fatal, "No number provided for Connection "//trim(Num2LStr(l))//" Turbine attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + else + CALL SetErrStat( ErrID_Fatal, "Unidentified Type/BodyID for Connection "//trim(Num2LStr(l))//": "//trim(tempString1), ErrStat, ErrMsg, RoutineName ) + return + end if + + ! set initial velocity to zero + m%ConnectList(l)%rd(1) = 0.0_DbKi + m%ConnectList(l)%rd(2) = 0.0_DbKi + m%ConnectList(l)%rd(3) = 0.0_DbKi + + !also set number of attached lines to zero initially + m%ConnectList(l)%nAttached = 0 + + + ! check for sequential IdNums + IF ( m%ConnectList(l)%IdNum .NE. l ) THEN + CALL SetErrStat( ErrID_Fatal, 'Connection numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + - p%dtCoupling = DTcoupling ! store coupling time step for use in updatestates + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to read data for Connection '//trim(Num2LStr(l)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + IF (wordy > 0) print *, "Set up Point ", l, " of type ", m%ConnectList(l)%typeNum - other%dummy = 0 - xd%dummy = 0 - z%dummy = 0 + END DO ! l = 1,p%nRods - CONTAINS + !------------------------------------------------------------------------------------------- + else if ((INDEX(Line, "LINES") > 0 ) .or. (INDEX(Line, "LINE PROPERTIES") > 0) .or. (INDEX(Line, "LINE LIST") > 0) ) then ! if line properties header - SUBROUTINE CheckError(ErrID,Msg) - ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev + IF (wordy > 0) print *, "Reading Lines" + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each line + DO l = 1,p%nLines + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + 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 + END IF + + ! parse out entries: ID LineType AttachA AttachB UnstrLen NumSegs Outputs (note: order changed Dec 13, 2021 before MDv2 release) + IF (ErrStat2 == 0) THEN + READ(Line,*,IOSTAT=ErrStat2) m%LineList(l)%IdNum, tempString1, tempString2, tempString3, & + m%LineList(l)%UnstrLen, m%LineList(l)%N, LineOutString + END IF + + ! identify index of line type + DO J = 1,p%nLineTypes + IF (trim(tempString1) == trim(m%LineTypeList(J)%name)) THEN + m%LineList(l)%PropsIdNum = J + EXIT + END IF + IF (J == p%nLineTypes) THEN ! call an error if there is no match + CALL SetErrStat( ErrID_Fatal, 'Unable to find matching line type name for Line '//trim(Num2LStr(l)), ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + END DO + + ! account for states of line + m%LineStateIs1(l) = Nx + 1 + if (m%LineTypeList(m%LineList(l)%PropsIdNum)%ElasticMod == 2) then + Nx = Nx + 7*m%LineList(l)%N - 6 ! if using viscoelastic model, need one more state per segment + m%LineStateIsN(l) = Nx + else + Nx = Nx + 6*m%LineList(l)%N - 6 ! normal case, just 6 states per internal node + m%LineStateIsN(l) = Nx + end if + + ! Process attachment identfiers and attach line ends + + ! First for the anchor (or end A)... + + call DecomposeString(tempString2, let1, num1, let2, num2, let3) + + if (len_trim(num1)<1) then + CALL SetErrStat( ErrID_Fatal, "Error: no number provided for line "//trim(Num2LStr(l))//" end A attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + READ(num1, *) J ! convert to int + + ! if id starts with an "R" or "Rod" + if ((let1 == "R") .or. (let1 == "ROD")) then + + if ((J <= p%nRods) .and. (J > 0)) then + if (let2 == "A") then + CALL Rod_AddLine(m%RodList(J), l, 0, 0) ! add line l (end A, denoted by 0) to rod J (end A, denoted by 0) + else if (let2 == "B") then + CALL Rod_AddLine(m%RodList(J), l, 0, 1) ! add line l (end A, denoted by 0) to rod J (end B, denoted by 1) + else + CALL SetErrStat( ErrID_Fatal, "Error: rod end (A or B) must be specified for line "//trim(Num2LStr(l))//" end A attachment. Instead seeing "//let2, ErrStat, ErrMsg, RoutineName ) + return + end if + else + CALL SetErrStat( ErrID_Fatal, "Error: rod connection ID out of bounds for line "//trim(Num2LStr(l))//" end A attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + ! if J starts with a "C" or "Con" or goes straight ot the number then it's attached to a Connection + else if ((len_trim(let1)==0) .or. (let1 == "C") .or. (let1 == "CON")) then + + if ((J <= p%nConnects) .and. (J > 0)) then + CALL Connect_AddLine(m%ConnectList(J), l, 0) ! add line l (end A, denoted by 0) to connection J + else + CALL SetErrStat( ErrID_Fatal, "Error: connection out of bounds for line "//trim(Num2LStr(l))//" end A attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + end if + + + ! Then again for the fairlead (or end B)... + + call DecomposeString(tempString3, let1, num1, let2, num2, let3) + + if (len_trim(num1)<1) then + CALL SetErrStat( ErrID_Fatal, "Error: no number provided for line "//trim(Num2LStr(l))//" end B attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + READ(num1, *) J ! convert to int + + ! if id starts with an "R" or "Rod" + if ((let1 == "R") .or. (let1 == "ROD")) then + + if ((J <= p%nRods) .and. (J > 0)) then + if (let2 == "A") then + CALL Rod_AddLine(m%RodList(J), l, 1, 0) ! add line l (end B, denoted by 1) to rod J (end A, denoted by 0) + else if (let2 == "B") then + CALL Rod_AddLine(m%RodList(J), l, 1, 1) ! add line l (end B, denoted by 1) to rod J (end B, denoted by 1) + else + CALL SetErrStat( ErrID_Fatal, "Error: rod end (A or B) must be specified for line "//trim(Num2LStr(l))//" end B attachment. Instead seeing "//let2, ErrStat, ErrMsg, RoutineName ) + 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 ) + return + end if + + ! if J starts with a "C" or "Con" or goes straight ot the number then it's attached to a Connection + else if ((len_trim(let1)==0) .or. (let1 == "C") .or. (let1 == "CON")) then + + if ((J <= p%nConnects) .and. (J > 0)) then + CALL Connect_AddLine(m%ConnectList(J), l, 1) ! add line l (end B, denoted by 1) to connection J + else + CALL SetErrStat( ErrID_Fatal, "Error: connection out of bounds for line "//trim(Num2LStr(l))//" end B attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + end if + + + ! process output flag characters (LineOutString) and set line output flag array (OutFlagList) + m%LineList(l)%OutFlagList = 0 ! first set array all to zero + ! per node 3 component + IF ( scan( LineOutString, 'p') > 0 ) m%LineList(l)%OutFlagList(2) = 1 + IF ( scan( LineOutString, 'v') > 0 ) m%LineList(l)%OutFlagList(3) = 1 + IF ( scan( LineOutString, 'U') > 0 ) m%LineList(l)%OutFlagList(4) = 1 + IF ( scan( LineOutString, 'D') > 0 ) m%LineList(l)%OutFlagList(5) = 1 + IF ( scan( LineOutString, 'b') > 0 ) m%LineList(l)%OutFlagList(6) = 1 ! seabed contact forces + ! per node 1 component + IF ( scan( LineOutString, 'W') > 0 ) m%LineList(l)%OutFlagList(7) = 1 ! node weight/buoyancy (positive up) + IF ( scan( LineOutString, 'K') > 0 ) m%LineList(l)%OutFlagList(8) = 1 ! curvature at node + ! per element 1 component + IF ( scan( LineOutString, 't') > 0 ) m%LineList(l)%OutFlagList(10) = 1 ! segment tension force (just EA) + IF ( scan( LineOutString, 'c') > 0 ) m%LineList(l)%OutFlagList(11) = 1 ! segment internal damping force + IF ( scan( LineOutString, 's') > 0 ) m%LineList(l)%OutFlagList(12) = 1 ! Segment strain + IF ( scan( LineOutString, 'd') > 0 ) m%LineList(l)%OutFlagList(13) = 1 ! Segment strain rate + IF ( scan( LineOutString, 'l') > 0 ) m%LineList(l)%OutFlagList(14) = 1 ! Segment stretched length + + IF (SUM(m%LineList(l)%OutFlagList) > 0) m%LineList(l)%OutFlagList(1) = 1 ! this first entry signals whether to create any output file at all + ! the above letter-index combinations define which OutFlagList entry corresponds to which output type + + + ! specify IdNum of line for error checking + m%LineList(l)%IdNum = l + + + ! check for sequential IdNums + IF ( m%LineList(l)%IdNum .NE. l ) THEN + CALL SetErrStat( ErrID_Fatal, 'Line numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + + ! setup line + CALL SetupLine( m%LineList(l), m%LineTypeList(m%LineList(l)%PropsIdNum), p, ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to read line data for Line '//trim(Num2LStr(l)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + END DO ! l = 1,p%nLines + + + + !------------------------------------------------------------------------------------------- + else if (INDEX(Line, "CONTROL") > 0) then ! if control inputs header + + IF (wordy > 0) print *, " Reading control inputs"; + + ! TODO: add stuff <<<<<<<< + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each line + DO l = 1,p%nCtrlChans + + !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 + + ! parse out entries: CtrlChan, LineIdNums + read(Line, *) Itemp, TempIDnums(1:N) ! parse out each line ID + + DO J = 1,N + if (TempIDnums(J) <= p%nLines) then ! ensure line ID is in range + 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))) + 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))) + end if + else + CALL WrScr('Error: Line ID '//TRIM(Int2LStr(TempIDnums(J)))//' of CtrlChan '//TRIM(Int2LStr(Itemp))//' is out of range') + end if + + END DO + + END DO + + + !------------------------------------------------------------------------------------------- + else if (INDEX(Line, "FAILURE") > 0) then ! if failure conditions header + + IF (wordy > 0) print *, " Reading failure conditions: (not implemented yet) "; + + ! TODO: add stuff <<<<<<<< + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each line + DO l = 1,p%nFails + + !read into a line + Line = NextLine(i) + + + READ(Line,*,IOSTAT=ErrStat2) m%LineList(l)%IdNum, tempString1, m%LineList(l)%UnstrLen, & + m%LineList(l)%N, tempString2, tempString3, LineOutString + + END DO + + + !------------------------------------------------------------------------------------------- + else if (INDEX(Line, "OUTPUT") > 0) then ! if output header + + IF (wordy > 0) print *, "Reading Outputs" + + ! (don't skip any lines) + + ! allocate InitInp%Outliest (to a really big number for now...) + CALL AllocAry( OutList, MaxAryLen, "MoorDyn Input File's Outlist", ErrStat2, ErrMsg2 ); if(Failed()) return + + + ! Initialize some values + p%NumOuts = 0 ! start counter at zero + OutList = '' + + + ! Read in all of the lines containing output parameters and store them in OutList(:) + ! customm implementation to avoid need for "END" keyword line + DO + ! read a line + Line = NextLine(i) + Line = adjustl(trim(Line)) ! remove leading whitespace + + CALL Conv2UC(Line) ! convert to uppercase for easy string matching + + if ((INDEX(Line, "---") > 0) .or. (INDEX(Line, "END") > 0)) EXIT ! stop if we hit a header line or the keyword "END" + + ! Check if we have a quoted string at the beginning. Ignore anything outside the quotes if so (this is the ReadVar behaviour for quoted strings). + IF (SCAN(Line(1:1), '''"' ) == 1_IntKi ) THEN + QuoteCh = SCAN( Line(2:), '''"' ) ! last quote + IF (QuoteCh < 1) QuoteCh = LEN_TRIM(Line) ! in case no end quote + Line(QuoteCh+2:) = ' ' ! blank out everything after last quote + END IF + + NumWords = CountWords( Line ) ! The number of words in Line. + + p%NumOuts = p%NumOuts + NumWords ! The total number of output channels read in so far. + + + IF ( p%NumOuts > MaxAryLen ) THEN ! Check to see if the maximum # allowable in the array has been reached. + + ErrStat = ErrID_Fatal + ErrMsg = 'Error while reading output channels: The maximum number of output channels allowed is '//TRIM( Int2LStr(MaxAryLen) )//'.' + EXIT + + ELSE + CALL GetWords ( Line, OutList((p%NumOuts - NumWords + 1):p%NumOuts), NumWords ) + + END IF + + END DO + + ! process the OutList array and set up the index arrays for the requested output quantities + CALL MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + + !------------------------------------------------------------------------------------------- + else ! otherwise ignore this line that isn't a recognized header line and read the next line + Line = NextLine(i) + end if + + !------------------------------------------------------------------------------------------- + + else ! otherwise ignore this line, which doesn't have the "---" or header line and read the next line + Line = NextLine(i) + end if + + end do + + + ! this is the end of parsing the input file, so cleanup anything we don't need anymore + CALL CleanUp() + + ! End of input file parsing from the FileInfo_In data structure + !------------------------------------------------------------------------------------------------- + + + + + + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + + + !------------------------------------------------------------------------------------------------- + ! Connect mooring system together and make necessary allocations + !------------------------------------------------------------------------------------------------- + + CALL WrNr(' Created mooring system: ' ) + +! p%NAnchs = 0 ! this is the number of "fixed" type Connections. <<<<<<<<<<<<<< + + CALL WrScr(trim(Num2LStr(p%nLines))//' lines, '//trim(Num2LStr(p%NConnects))//' points, '//trim(Num2LStr(p%nRods))//' rods, '//trim(Num2LStr(p%nBodies))//' bodies.') + + + + + ! ! now go back through and record the fairlead Id numbers (this >>>WAS<<< all the "connecting" that's required) <<<< + ! J = 1 ! counter for fairlead number + ! K = 1 ! counter for connect number + ! DO I = 1,p%NConnects + ! IF (m%ConnectList(I)%typeNum == 1) THEN + ! m%CpldConIs(J) = I ! if a vessel connection, add ID to list + ! J = J + 1 + ! ELSE IF (m%ConnectList(I)%typeNum == 2) THEN + ! m%FreeConIs(K) = I ! if a connect connection, add ID to list + ! K = K + 1 + ! END IF + ! END DO + + IF (wordy > 1) print *, "nLineTypes = ",p%nLineTypes + IF (wordy > 1) print *, "nRodTypes = ",p%nRodTypes + IF (wordy > 1) print *, "nConnects = ",p%nConnects + IF (wordy > 1) print *, "nConnectsExtra = ",p%nConnectsExtra + IF (wordy > 1) print *, "nBodies = ",p%nBodies + IF (wordy > 1) print *, "nRods = ",p%nRods + IF (wordy > 1) print *, "nLines = ",p%nLines + IF (wordy > 1) print *, "nCtrlChans = ",p%nCtrlChans + IF (wordy > 1) print *, "nFails = ",p%nFails + IF (wordy > 1) print *, "nFreeBodies = ",p%nFreeBodies + IF (wordy > 1) print *, "nFreeRods = ",p%nFreeRods + IF (wordy > 1) print *, "nFreeCons = ",p%nFreeCons + IF (wordy > 1) print *, "nCpldBodies = ",p%nCpldBodies + IF (wordy > 1) print *, "nCpldRods = ",p%nCpldRods + IF (wordy > 1) print *, "nCpldCons = ",p%nCpldCons + IF (wordy > 1) print *, "NConns = ",p%NConns + IF (wordy > 1) print *, "NAnchs = ",p%NAnchs + + IF (wordy > 2) print *, "FreeConIs are ", m%FreeConIs + IF (wordy > 2) print *, "CpldConIs are ", m%CpldConIs + + + ! write system description to log file + if (p%writeLog > 1) then + write(p%UnLog, '(A)') "----- MoorDyn Model Summary (to be written) -----" + end if + + + + !------------------------------------------------------------------------------------ + ! fill in state vector index record holders + !------------------------------------------------------------------------------------ + + ! allocate state vector index record holders... + + + + ! ! allocate list of starting and ending state vector indices for each free connection + ! ALLOCATE ( m%ConStateIs1(p%nFreeCons), m%ConStateIsN(p%nFreeCons), STAT = ErrStat ) + ! IF ( ErrStat /= ErrID_None ) THEN + ! CALL CheckError(ErrID_Fatal, ' Error allocating ConStateIs array.') + ! RETURN + ! END IF + ! + ! ! allocate list of starting and ending state vector indices for each line - does this belong elsewhere? + ! ALLOCATE ( m%LineStateIs1(p%nLines), m%LineStateIsN(p%nLines), STAT = ErrStat ) + ! IF ( ErrStat /= ErrID_None ) THEN + ! CALL CheckError(ErrID_Fatal, ' Error allocating LineStateIs arrays.') + ! RETURN + ! END IF + ! + ! + ! ! fill in values for state vector index record holders... + ! + ! J=0 ! start off index counter at zero + ! + ! ! Free Bodies... + ! ! Free Rods... + ! + ! ! Free Connections... + ! DO l = 1, p%nFreeCons + ! J = J + 1 ! assign start index + ! m%ConStateIs1(l) = J + ! + ! J = J + 5 ! assign end index (5 entries further, since nodes have 2*3 states) + ! m%ConStateIsN(l) = J + ! END DO + ! + ! ! Lines + ! DO l = 1, p%nLines + ! J = J + 1 ! assign start index + ! m%LineStateIs1(l) = J + ! + ! J = J + 6*(m%LineList(l)%N - 1) - 1 ! !add 6 state variables for each internal node + ! m%LineStateIsN(l) = J + ! END DO + ! + ! + ! ! record number of states + ! m%Nx = J + + + !------------------------------------------------------------------------------------ + ! prepare state vector etc. + !------------------------------------------------------------------------------------ + + ! the number of states is Nx + m%Nx = Nx + + IF (wordy > 0) print *, "allocating state vectors to size ", Nx + + ! 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 ) + IF ( ErrStat2 /= ErrID_None ) THEN + ErrMsg = ' Error allocating state vectors.' + !CALL CleanUp() + RETURN + END IF + x%states = 0.0_DbKi + m%xTemp%states = 0.0_DbKi + m%xdTemp%states = 0.0_DbKi + + + + ! ================================ initialize system ================================ + ! This will also set the initial positions of any dependent (child) objects + + ! call ground body to update all the fixed things... + m%GroundBody%r6(4:6) = 0.0_DbKi + CALL Body_SetDependentKin(m%GroundBody, 0.0_DbKi, m) + + ! m%GroundBody%OrMat = EulerConstruct( m%GroundBody%r6(4:6) ) ! make sure it's OrMat is set up <<< need to check this approach + + ! ! first set/update the kinematics of all the fixed things (>>>> eventually do this by using a ground body <<<<) + ! ! only doing connections so far + ! DO J = 1,p%nConnects + ! if (m%ConnectList(J)%typeNum == 1) then + ! ! set the attached line endpoint positions: + ! CALL Connect_SetKinematics(m%ConnectList(J), m%ConnectList(J)%r, (/0.0_DbKi,0.0_DbKi,0.0_DbKi/), 0.0_DbKi, m%LineList) + ! end if + ! END DO + + + ! Initialize coupled objects based on passed kinematics + ! (set up initial condition of each coupled object based on values specified by glue code) + ! Also create i/o meshes + + ALLOCATE ( u%CoupledKinematics(p%nTurbines), STAT = ErrStat2 ) + IF ( ErrStat2 /= ErrID_None ) THEN + CALL CheckError(ErrID_Fatal, ' Error allocating CoupledKinematics input array.') + RETURN + END IF + ALLOCATE ( y%CoupledLoads(p%nTurbines), STAT = ErrStat2 ) + IF ( ErrStat2 /= ErrID_None ) THEN + CALL CheckError(ErrID_Fatal, ' Error allocating CoupledLoads output array.') + RETURN + END IF + + ! Go through each turbine and set up its mesh and initial positions of coupled objects + 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 + + ! count number of coupling nodes needed for the mesh of this turbine + K = p%nCpldBodies(iTurb) + p%nCpldRods(iTurb) + p%nCpldCons(iTurb) + if (K == 0) K = 1 ! Always have at least one node (it will be a dummy node if no fairleads are attached) + + ! create input mesh for fairlead kinematics + CALL MeshCreate(BlankMesh=u%CoupledKinematics(iTurb) , & + IOS= COMPONENT_INPUT, Nnodes = K, & + TranslationDisp=.TRUE., TranslationVel=.TRUE., & + Orientation=.TRUE., RotationVel=.TRUE., & + TranslationAcc=.TRUE., RotationAcc= .TRUE., & + ErrStat=ErrStat2, ErrMess=ErrMsg2) + + 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 connections + ! >>> 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 <<<< + + + 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 <<< + + ! set absolute initial positions in MoorDyn + 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 + + CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! set node as point element + + ! lastly, do this to initialize any attached Rods or Points and set their positions + CALL Body_InitializeUnfree( m%BodyList(m%CpldBodyIs(l,iTurb)), m ) + + END DO + + DO l = 1,p%nCpldRods(iTurb) ! keeping this one simple for now, positioning at whatever is specified in input file <<<<< should change to glue code! + 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 <<< + CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) ! assign the reference position and orientation + + ! 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) + + 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 + + ! >>> 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: + CALL Rod_SetKinematics(m%RodList(m%CpldRodIs(l,iTurb)), DBLE(rRef), m%zeros6, m%zeros6, 0.0_DbKi, m) + END DO + + DO l = 1,p%nCpldCons(iTurb) ! keeping this one simple for now, positioning at whatever is specified by glue code <<< + J = J + 1 + + ! set reference position as per input file <<< what about turbine positions in array? + rRef(1:3) = m%ConnectList(m%CpldConIs(l,iTurb))%r + 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 + m%ConnectList(m%CpldConIs(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: + rRefDub = rRef(1:3) + CALL Connect_SetKinematics(m%ConnectList(m%CpldConIs(l,iTurb)), rRefDub, m%zeros6(1:3), m%zeros6(1:3), 0.0_DbKi, m) + END DO + + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + ! if no coupled objects exist for this turbine, add a single dummy element to keep I/O interp/extrap routines happy + if (J == 0) then + rRef = 0.0_DbKi ! position at PRP + CALL MeshPositionNode(u%CoupledKinematics(iTurb), 1, rRef, ErrStat2, ErrMsg2) + CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, 1) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + end if + + ! set velocities/accelerations of all mesh nodes to zero + u%CoupledKinematics(iTurb)%TranslationVel = 0.0_ReKi + u%CoupledKinematics(iTurb)%TranslationAcc = 0.0_ReKi + u%CoupledKinematics(iTurb)%RotationVel = 0.0_ReKi + u%CoupledKinematics(iTurb)%RotationAcc = 0.0_ReKi + + CALL MeshCommit ( u%CoupledKinematics(iTurb), ErrStat2, ErrMsg ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + ! copy the input fairlead kinematics mesh to make the output mesh for fairlead loads, PtFairleadLoad + CALL MeshCopy ( SrcMesh = u%CoupledKinematics(iTurb), DestMesh = y%CoupledLoads(iTurb), & + CtrlCode = MESH_SIBLING, IOS = COMPONENT_OUTPUT, & + Force = .TRUE., Moment = .TRUE., ErrStat = ErrStat2, ErrMess=ErrMsg2 ) + + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + end do ! iTurb + + ! >>>>>> ensure the output mesh includes all elements from u%(Farm)CoupledKinematics, OR make a seperate array of output meshes for each turbine <<<<<<<<< + + + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + + ! ----------------------------- Arrays for active tensioning --------------------------- + + ! size active tensioning inputs arrays based on highest channel number read from input file for now <<<<<<< + + ! find the highest channel number + N = 0 + DO I = 1, p%NLines + IF ( m%LineList(I)%CtrlChan > N ) then + N = m%LineList(I)%CtrlChan + END IF + END DO + + ! note: it would be nice to just have input arrays of the number of control channels used, rather than from 1 up to N (the highest CtrlChan) + + ! allocate the input arrays (if any requested) + if (N > 0) then + call AllocAry( u%DeltaL, N, 'u%DeltaL', ErrStat2, ErrMsg2 ) + call CheckError( ErrStat2, ErrMsg2 ) + if (ErrStat >= AbortErrLev) return + u%DeltaL = 0.0_ReKi + call AllocAry( u%DeltaLdot, N, 'u%DeltaLdot', ErrStat2, ErrMsg2 ) + call CheckError( ErrStat2, ErrMsg2 ) + if (ErrStat >= AbortErrLev) return + u%DeltaLdot = 0.0_ReKi + call AllocAry( InitOut%CableCChanRqst, N, 'CableCChanRqst', ErrStat2, ErrMsg2 ) + call CheckError( ErrStat2, ErrMsg2 ) + if (ErrStat >= AbortErrLev) return + InitOut%CableCChanRqst = .FALSE. ! Initialize to false + do J=1,p%NLines + if (m%LineList(J)%CtrlChan > 0) InitOut%CableCChanRqst(m%LineList(J)%CtrlChan) = .TRUE. ! set the flag of the corresponding channel to true + enddo + endif + + + ! >>> set up wave stuff here??? <<< + + + m%WaveTi = 1 ! set initial wave grid time interpolation index to 1 to start with + + + ! Frmt = '(A10,'//TRIM(Int2LStr(p%NumOuts))//'(A1,A12))' + ! + ! WRITE(p%MDUnOut,Frmt, IOSTAT=ErrStat2) TRIM( 'Time' ), ( p%Delim, TRIM( p%OutParam(I)%Name), I=1,p%NumOuts ) + ! + ! WRITE(p%MDUnOut,Frmt) TRIM( '(s)' ), ( p%Delim, TRIM( p%OutParam(I)%Units ), I=1,p%NumOuts ) + ! + ! + ! + ! ! Write the output parameters to the file + ! + ! Frmt = '(F10.4,'//TRIM(Int2LStr(p%NumOuts))//'(A1,e10.4))' + ! + ! WRITE(p%MDUnOut,Frmt) Time, ( p%Delim, y%WriteOutput(I), I=1,p%NumOuts ) + + + + ! ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + + ! if any of the coupled objects need initialization steps, that should have been taken care of already <<<< + + + ! initialize objects with states, writing their initial states to the master state vector (x%states) + + + !TODO: apply any initial adjustment of line length from active tensioning <<<<<<<<<<<< + ! >>> maybe this should be skipped <<<< + + + ! Go through Bodys 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 + + ! Go through independent (including pinned) Rods and write the coordinates to the state vector + DO l = 1,p%nFreeRods + CALL Rod_Initialize(m%RodList(m%FreeRodIs(l)), x%states(m%RodStateIs1(l):m%RodStateIsN(l)), m) + END DO + + ! Go through independent connections (Connects) and write the coordinates to the state vector and set positions of attached line ends + DO l = 1, p%nFreeCons + CALL Connect_Initialize(m%ConnectList(m%FreeConIs(l)), x%states(m%ConStateIs1(l) : m%conStateIsN(l)), m) + END DO + + + ! Lastly, go through lines and initialize internal node positions using quasi-static model + DO l = 1, p%NLines + + N = m%LineList(l)%N ! for convenience + + ! ! set end node positions and velocities from connect objects + ! m%LineList(l)%r(:,N) = m%ConnectList(m%LineList(l)%FairConnect)%r + ! m%LineList(l)%r(:,0) = m%ConnectList(m%LineList(l)%AnchConnect)%r + ! m%LineList(l)%rd(:,N) = (/ 0.0, 0.0, 0.0 /) ! set anchor end velocities to zero + ! m%LineList(l)%rd(:,0) = (/ 0.0, 0.0, 0.0 /) ! set fairlead end velocities to zero + + ! set initial line internal node positions using quasi-static model or straight-line interpolation from anchor to fairlead + CALL Line_Initialize( m%LineList(l), m%LineTypeList(m%LineList(l)%PropsIdNum), p%rhoW , ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + !IF (ErrStat >= ErrId_Warn) CALL WrScr(" Note: Catenary pre-solver was unsuccessful for one or more lines so started with linear node spacing instead.") ! make this statement more accurate + + IF (wordy > 2) print *, "Line ", l, " with NumSegs =", N + IF (wordy > 2) print *, "its states range from index ", m%LineStateIs1(l), " to ", m%LineStateIsN(l) + + ! assign the resulting internal node positions to the integrator initial state vector! (velocities leave at 0) + DO I = 1, N-1 +! print *, "I=", I + DO J = 1, 3 +! print*, J, " ... writing position state to index ", 1*(m%LineStateIs1(l) + 3*N-3 + 3*I-3 + J-1) + x%states(m%LineStateIs1(l) + 3*N-3 + 3*I-3 + J-1 ) = m%LineList(l)%r(J,I) ! assign position + x%states(m%LineStateIs1(l) + 3*I-3 + J-1 ) = 0.0_DbKi ! assign velocities (of zero) + END DO +! print *, m%LineList(l)%r(:,I) + END DO + + ! if using viscoelastic model, initialize the internal states + if (m%LineList(l)%ElasticMod == 2) then + do I = 1,N + x%states(m%LineStateIs1(l) + 6*N-6 + I-1) = m%LineList(l)%dl_1(I) ! should be zero + end do + end if + + + END DO !l = 1, p%NLines + + + + ! -------------------------------------------------------------------- + ! open output file(s) and write header lines + CALL MDIO_OpenOutput( p, m, InitOut, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + ! -------------------------------------------------------------------- + + + IF (wordy > 2) THEN + print *,"Done setup of the system (before any dynamic relaxation. State vector is as follows:" + + DO I = 1, m%Nx + print *, x%states(I) + END DO + END IF + +! ! try writing output for troubleshooting purposes (TEMPORARY) +! CALL MDIO_WriteOutputs(-1.0_DbKi, p, m, y, ErrStat, ErrMsg) +! IF ( ErrStat >= AbortErrLev ) THEN +! ErrMsg = ' Error in MDIO_WriteOutputs: '//TRIM(ErrMsg) +! RETURN +! END IF +! END DO + + ! ------------------------------------------------------------------- + ! if log file, compute and write some object properties + ! ------------------------------------------------------------------- + if (p%writeLog > 1) then + + write(p%UnLog, '(A)' ) " Bodies:" + DO l = 1,p%nBodies + write(p%UnLog, '(A)' ) " Body"//trim(num2lstr(l))//":" + write(p%UnLog, '(A12, f12.4)') " mass: ", m%BodyList(l)%M(1,1) + END DO + + write(p%UnLog, '(A)' ) " Rods:" + DO l = 1,p%nRods + write(p%UnLog, '(A)' ) " Rod"//trim(num2lstr(l))//":" + ! m%RodList(l) + END DO + + write(p%UnLog, '(A)' ) " Points:" + DO l = 1,p%nFreeCons + write(p%UnLog, '(A)' ) " Point"//trim(num2lstr(l))//":" + ! m%ConnectList(l) + 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 + + end if + + + ! -------------------------------------------------------------------- + ! do dynamic relaxation to get ICs + ! -------------------------------------------------------------------- + + ! only do this if TMaxIC > 0 + if (InputFileDat%TMaxIC > 0.0_DbKi) then + + CALL WrScr(" Finalizing initial conditions using dynamic relaxation."//NewLine) ! newline because next line writes over itself + + ! boost drag coefficient of each line type <<<<<<<< does this actually do anything or do lines hold these coefficients??? + DO I = 1, p%nLineTypes + m%LineTypeList(I)%Cdn = m%LineTypeList(I)%Cdn * InputFileDat%CdScaleIC + m%LineTypeList(I)%Cdt = m%LineTypeList(I)%Cdt * InputFileDat%CdScaleIC ! <<<<< need to update this to apply to all objects' drag + END DO + + ! allocate array holding 10 latest fairlead tensions + ALLOCATE ( FairTensIC(p%nLines, 10), STAT = ErrStat2 ) + IF ( ErrStat2 /= ErrID_None ) THEN + CALL CheckError( ErrID_Fatal, ErrMsg2 ) + RETURN + END IF + + ! initialize fairlead tension memory at changing values so things start unconverged + DO J = 1,p%nLines + DO I = 1, 10 + FairTensIC(J,I) = I + END DO + END DO + + + ! round dt to integer number of time steps + NdtM = ceiling(InputFileDat%dtIC/p%dtM0) ! get number of mooring time steps to do based on desired time step size + dtM = InputFileDat%dtIC/real(NdtM, DbKi) ! adjust desired time step to satisfy dt with an integer number of time steps + + t = 0.0_DbKi ! start time at zero + + ! because TimeStep wants an array... + call MD_CopyInput( u, u_array(1), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) ! make a size=1 array of inputs (since MD_RK2 expects an array to InterpExtrap) + call MD_CopyInput( u, u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) ! also make an inputs object to interpExtrap to + t_array(1) = t ! fill in the times "array" for u_array + + DO I = 1, ceiling(InputFileDat%TMaxIC/InputFileDat%dtIC) ! loop through IC gen time steps, up to maximum + + + !loop through line integration time steps + DO J = 1, NdtM ! for (double ts=t; ts<=t+ICdt-dts; ts+=dts) + + CALL MD_RK2(t, dtM, u_interp, u_array, t_array, p, x, xd, z, other, m, ErrStat2, ErrMsg2) + + ! check for NaNs - is this a good place/way to do it? + DO K = 1, m%Nx + IF (Is_NaN(x%states(K))) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' NaN state detected.' + EXIT + END IF + END DO + + IF (ErrStat == ErrID_Fatal) THEN + CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t))//" during MoorDyn's dynamic relaxation process.") + IF (wordy > 1) THEN + print *, "Here is the state vector: " + print *, x%states + END IF + EXIT + END IF + + END DO ! J time steps + + ! ! integrate the EOMs one DTIC s time step + ! CALL TimeStep ( t, InputFileDat%dtIC, u_array, t_array, p, x, xd, z, other, m, ErrStat, ErrMsg ) + ! CALL CheckError( ErrStat2, ErrMsg2 ) + ! IF (ErrStat >= AbortErrLev) RETURN + + ! store new fairlead tension (and previous fairlead tensions for comparison) + DO l = 1, p%nLines + + DO K=0,8 ! we want to count down from 10 to 2 . + FairTensIC(l, 10-K) = FairTensIC(l, 9-K) ! this pushes stored values up in the array + END DO + + ! now store latest value of each line's fairlead (end B) tension + FairTensIC(l,1) = TwoNorm(m%LineList(l)%Fnet(:, m%LineList(l)%N)) + END DO + + + ! provide status message + ! bjj: putting this in a string so we get blanks to cover up previous values (if current string is shorter than previous one) + Message = ' t='//trim(Num2LStr(t))//' FairTen 1: '//trim(Num2LStr(FairTensIC(1,1)))// & + ', '//trim(Num2LStr(FairTensIC(1,2)))//', '//trim(Num2LStr(FairTensIC(1,3))) + CALL WrOver( Message ) + + ! check for convergence (compare current tension at each fairlead with previous 9 values) + IF (I > 9) THEN + + Converged = 1 + + ! check for non-convergence + + DO l = 1, p%nLines + DO K = 1,9 + IF ( abs( FairTensIC(l,K)/FairTensIC(l,K+1) - 1.0 ) > InputFileDat%threshIC ) THEN + Converged = 0 + EXIT + END IF + END DO + + IF (Converged == 0) EXIT ! make sure we exit this loop too + END DO + + IF (Converged == 1) THEN ! if we made it with all cases satisfying the threshold + CALL WrScr(' Fairlead tensions converged to '//trim(Num2LStr(100.0*InputFileDat%threshIC))//'% after '//trim(Num2LStr(t))//' seconds.') + EXIT ! break out of the time stepping loop + END IF + END IF + + IF (I == ceiling(InputFileDat%TMaxIC/InputFileDat%dtIC) ) THEN + CALL WrScr(' Fairlead tensions did not converge within TMaxIC='//trim(Num2LStr(InputFileDat%TMaxIC))//' seconds.') + !ErrStat = ErrID_Warn + !ErrMsg = ' MD_Init: ran dynamic convergence to TMaxIC without convergence' + END IF + + END DO ! I ... looping through time steps + + + + CALL MD_DestroyInput( u_array(1), ErrStat2, ErrMsg2 ) + + ! UNboost drag coefficient of each line type <<< + DO I = 1, p%nLineTypes + m%LineTypeList(I)%Cdn = m%LineTypeList(I)%Cdn / InputFileDat%CdScaleIC + m%LineTypeList(I)%Cdt = m%LineTypeList(I)%Cdt / InputFileDat%CdScaleIC + END DO + + end if ! InputFileDat%TMaxIC > 0 + + + p%dtCoupling = DTcoupling ! store coupling time step for use in updatestates + + other%dummy = 0 + xd%dummy = 0 + z%dummy = 0 + + if (InitInp%Linearize) then + call MD_Init_Jacobian(InitInp, p, u, y, m, InitOut, ErrStat2, ErrMsg2); if(Failed()) return + endif + + CALL WrScr(' MoorDyn initialization completed.') + + m%LastOutTime = -1.0_DbKi ! set to nonzero to ensure that output happens at the start of simulation at t=0 + + ! TODO: add feature for automatic water depth increase based on max anchor depth! + + CONTAINS + + + LOGICAL FUNCTION AllocateFailed(arrayName) + + CHARACTER(*), INTENT(IN ) :: arrayName ! The array name + + call SetErrStat(ErrStat2, "Error allocating space for "//trim(arrayName)//" array.", ErrStat, ErrMsg, 'MD_Init') + AllocateFailed = ErrStat2 >= AbortErrLev + if (AllocateFailed) call CleanUp() !<<<<<<<<<< need to fix this up + END FUNCTION AllocateFailed + + + LOGICAL FUNCTION Failed() + + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_Init') + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + END FUNCTION Failed + + + SUBROUTINE CheckError(ErrID,Msg) + ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev ! Passed arguments INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) ! Set error status/message; IF ( ErrID /= ErrID_None ) THEN @@ -516,29 +2252,54 @@ SUBROUTINE CheckError(ErrID,Msg) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(m%FairIdList )) DEALLOCATE(m%FairIdList ) - IF (ALLOCATED(m%ConnIdList )) DEALLOCATE(m%ConnIdList ) - IF (ALLOCATED(m%LineStateIndList )) DEALLOCATE(m%LineStateIndList ) + IF (ALLOCATED(m%CpldConIs )) DEALLOCATE(m%CpldConIs ) + IF (ALLOCATED(m%FreeConIs )) DEALLOCATE(m%FreeConIs ) + IF (ALLOCATED(m%LineStateIs1 )) DEALLOCATE(m%LineStateIs1 ) + IF (ALLOCATED(m%LineStateIsN )) DEALLOCATE(m%LineStateIsN ) + IF (ALLOCATED(m%ConStateIs1 )) DEALLOCATE(m%ConStateIs1 ) + IF (ALLOCATED(m%ConStateIsN )) DEALLOCATE(m%ConStateIsN ) IF (ALLOCATED(x%states )) DEALLOCATE(x%states ) - IF (ALLOCATED(FairTensIC )) DEALLOCATE(FairTensIC ) + IF (ALLOCATED(FairTensIC )) DEALLOCATE(FairTensIC ) + + call CleanUp() ! make sure to close files END IF END IF 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 + !! in a while looking for the next section and accidentally overstep the end of the array + !! resulting in a segfault. This function will trap that issue and return a section break + CHARACTER(1024) function NextLine(i) + integer, intent(inout) :: i ! Current line number corresponding to contents of NextLine + i=i+1 ! Increment to line next line. + if (i>FileInfo_In%NumLines) then + NextLine="---" ! Set as a separator so we can escape some of the while loops + else + NextLine=trim(FileInfo_In%Lines(i)) + !TODO: add comment character recognition here? (discard any characters past a #) + endif + end function NextLine + END SUBROUTINE MD_Init - !============================================================================================== + !----------------------------------------------------------------------------------------====== - !============================================================================================== - SUBROUTINE MD_UpdateStates( t, n, u, utimes, p, x, xd, z, other, m, ErrStat, ErrMsg) + !----------------------------------------------------------------------------------------====== + SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, ErrMsg) REAL(DbKi) , INTENT(IN ) :: t INTEGER(IntKi) , INTENT(IN ) :: n TYPE(MD_InputType) , INTENT(INOUT) :: u(:) ! INTENT(INOUT) ! had to change this to INOUT - REAL(DbKi) , INTENT(IN ) :: utimes(:) + REAL(DbKi) , INTENT(IN ) :: t_array(:) TYPE(MD_ParameterType) , INTENT(IN ) :: p ! INTENT(IN ) TYPE(MD_ContinuousStateType) , INTENT(INOUT) :: x ! INTENT(INOUT) TYPE(MD_DiscreteStateType) , INTENT(INOUT) :: xd ! INTENT(INOUT) @@ -553,11 +2314,16 @@ SUBROUTINE MD_UpdateStates( t, n, u, utimes, p, x, xd, z, other, m, ErrStat, Err ! moved to TimeStep TYPE(MD_InputType) :: u_interp ! INTEGER(IntKi) :: nTime + + TYPE(MD_InputType) :: u_interp ! interpolated instantaneous input values to be calculated for each mooring time step - REAL(DbKi) :: t2 ! copy of time passed to TimeStep - + REAL(DbKi) :: t2 ! copy of time variable that will get advanced by the integrator (not sure this is necessary<<<) + REAL(DbKi) :: dtM ! actual mooring dynamics time step + INTEGER(IntKi) :: NdtM ! number of time steps to integrate through with RK2 + INTEGER(IntKi) :: I + INTEGER(IntKi) :: J - nTime = size(u) ! the number of times of input data provided? + nTime = size(u) ! the number of times of input data provided? <<<<<<< not used t2 = t @@ -568,29 +2334,90 @@ SUBROUTINE MD_UpdateStates( t, n, u, utimes, p, x, xd, z, other, m, ErrStat, Err ! IF (ErrStat >= AbortErrLev) RETURN ! ! ! interpolate input mesh to correct time -! CALL MD_Input_ExtrapInterp(u, utimes, u_interp, t, ErrStat2, ErrMsg2) +! CALL MD_Input_ExtrapInterp(u, t_array, u_interp, t, ErrStat2, ErrMsg2) ! CALL CheckError( ErrStat2, ErrMsg2 ) ! IF (ErrStat >= AbortErrLev) RETURN ! ! ! ! go through fairleads and apply motions from driver -! DO I = 1, p%NFairs +! DO I = 1, p%nCpldCons ! DO J = 1,3 -! m%ConnectList(m%FairIdList(I))%r(J) = u_interp%PtFairleadDisplacement%Position(J,I) + u_interp%PtFairleadDisplacement%TranslationDisp(J,I) -! m%ConnectList(m%FairIdList(I))%rd(J) = u_interp%PtFairleadDisplacement%TranslationVel(J,I) ! is this right? <<< +! m%ConnectList(m%CpldConIs(I))%r(J) = u_interp%PtFairleadDisplacement%Position(J,I) + u_interp%PtFairleadDisplacement%TranslationDisp(J,I) +! m%ConnectList(m%CpldConIs(I))%rd(J) = u_interp%PtFairleadDisplacement%TranslationVel(J,I) ! is this right? <<< ! END DO ! END DO ! - ! call function that loops through mooring model time steps - CALL TimeStep ( t2, p%dtCoupling, u, utimes, p, x, xd, z, other, m, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - ! clean up input interpolation stuff - ! moved to TimeStep CALL MD_DestroyInput(u_interp, ErrStat, ErrMsg) +! ! call function that loops through mooring model time steps +! CALL TimeStep ( t2, p%dtCoupling, u, t_array, p, x, xd, z, other, m, ErrStat2, ErrMsg2 ) +! CALL CheckError( ErrStat2, ErrMsg2 ) +! IF (ErrStat >= AbortErrLev) RETURN + + + ! create space for arrays/meshes in u_interp ... is it efficient to do this every time step??? + CALL MD_CopyInput(u(1), u_interp, MESH_NEWCOPY, ErrStat, ErrMsg) + + + ! round dt to integer number of time steps <<<< should this be calculated only once, up front? + NdtM = ceiling(p%dtCoupling/p%dtM0) ! get number of mooring time steps to do based on desired time step size + dtM = p%dtCoupling/REAL(NdtM,DbKi) ! adjust desired time step to satisfy dt with an integer number of time steps + + + !loop through line integration time steps + DO I = 1, NdtM ! for (double ts=t; ts<=t+ICdt-dts; ts+=dts) + + CALL MD_RK2(t2, dtM, u_interp, u, t_array, p, x, xd, z, other, m, ErrStat2, ErrMsg2) + + + ! check for NaNs - is this a good place/way to do it? + DO J = 1, m%Nx + IF (Is_NaN(x%states(J))) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' NaN state detected.' + 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 + + + ! destroy dxdt and x2, and u_interp + !CALL MD_DestroyContState( dxdt, ErrStat, ErrMsg) + !CALL MD_DestroyContState( x2, ErrStat, ErrMsg) + CALL MD_DestroyInput(u_interp, ErrStat, ErrMsg) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error destroying dxdt or x2.' + END IF + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_UpdateStates') + + ! check for NaNs - is this a good place/way to do it? + DO J = 1, m%Nx + IF (Is_NaN(x%states(J))) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' NaN state detected.' + 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 CONTAINS @@ -618,11 +2445,11 @@ SUBROUTINE CheckError(ErrId, Msg) END SUBROUTINE CheckError END SUBROUTINE MD_UpdateStates - !======================================================================================== + !---------------------------------------------------------------------------------------- - !======================================================================================== + !---------------------------------------------------------------------------------------- SUBROUTINE MD_CalcOutput( t, u, p, x, xd, z, other, y, m, ErrStat, ErrMsg ) REAL(DbKi) , INTENT(IN ) :: t @@ -637,46 +2464,148 @@ SUBROUTINE MD_CalcOutput( t, u, p, x, xd, z, other, y, m, ErrStat, ErrMsg ) INTEGER(IntKi) , INTENT(INOUT) :: ErrStat CHARACTER(*) , INTENT(INOUT) :: ErrMsg - TYPE(MD_ContinuousStateType) :: dxdt ! time derivatives of continuous states (initialized in CalcContStateDeriv) - INTEGER(IntKi) :: I ! counter - INTEGER(IntKi) :: J ! counter - - INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None + ! TYPE(MD_ContinuousStateType) :: dxdt ! time derivatives of continuous states (initialized in CalcContStateDeriv) + INTEGER(IntKi) :: I ! counter + INTEGER(IntKi) :: J ! counter + INTEGER(IntKi) :: K ! counter + INTEGER(IntKi) :: l ! index used for objects + INTEGER(IntKi) :: iTurb ! counter + + Real(DbKi) :: F6net(6) ! net force and moment calculated on coupled objects + + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None ! below updated to make sure outputs are current (based on provided x and u) - similar to what's in UpdateStates - ! go through fairleads and apply motions from driver - DO I = 1, p%NFairs - DO J = 1,3 - m%ConnectList(m%FairIdList(I))%r(J) = u%PtFairleadDisplacement%Position(J,I) + u%PtFairleadDisplacement%TranslationDisp(J,I) - m%ConnectList(m%FairIdList(I))%rd(J) = u%PtFairleadDisplacement%TranslationVel(J,I) ! is this right? <<< - END DO - END DO + ! ! go through fairleads and apply motions from driver + ! DO I = 1, p%nCpldCons + ! DO J = 1,3 + ! m%ConnectList(m%CpldConIs(I))%r(J) = u%CoupledKinematics%Position(J,I) + u%CoupledKinematics%TranslationDisp(J,I) + ! m%ConnectList(m%CpldConIs(I))%rd(J) = u%CoupledKinematics%TranslationVel(J,I) ! is this right? <<< + ! END DO + ! END DO + + + ! ! go through nodes and apply wave kinematics from driver (if water kinematics were passed in at each node in future) + ! IF (p%WaterKin > 0) THEN + ! + ! J=0 + ! ! Body reference point coordinates + ! DO I = 1, p%nBodies + ! J = J + 1 + ! m%BodyList(I)%U = u%U(:,J) + ! m%BodyList(I)%Ud = u%Ud(:,J) + ! m%BodyList(I)%zeta = u%zeta(J) + ! END DO + ! ! Rod node coordinates + ! DO I = 1, p%nRods + ! DO K = 0,m%RodList(I)%N + ! J = J + 1 + ! m%RodList(I)%U (:,K) = u%U(:,J) + ! m%RodList(I)%Ud(:,K) = u%Ud(:,J) + ! m%RodList(I)%zeta(K) = u%zeta(J) + ! m%RodList(I)%PDyn(K) = u%PDyn(J) + ! END DO + ! END DO + ! ! Point reference point coordinates + ! DO I = 1, p%nConnects + ! J = J + 1 + ! m%ConnectList(I)%U = u%U(:,J) + ! m%ConnectList(I)%Ud = u%Ud(:,J) + ! m%ConnectList(I)%zeta = u%zeta(J) + ! END DO + ! ! Line internal node coordinates + ! DO I = 1, p%nLines + ! DO K = 1, m%LineList(I)%N-1 + ! J = J + 1 + ! m%LineList(I)%U (:,K) = u%U(:,J) + ! m%LineList(I)%Ud(:,K) = u%Ud(:,J) + ! m%LineList(I)%zeta(K) = u%zeta(J) + ! END DO + ! END DO + ! + ! END IF + + ! call CalcContStateDeriv in order to run model and calculate dynamics with provided x and u - CALL MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, ErrMsg ) - - - ! assign net force on fairlead Connects to the output mesh - DO i = 1, p%NFairs - DO J=1,3 - y%PtFairleadLoad%Force(J,I) = m%ConnectList(m%FairIdList(I))%Ftot(J) + CALL MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, m%xdTemp, ErrStat, ErrMsg ) + + ! ! assign net force on fairlead Connects to the fairlead force output mesh + ! DO i = 1, p%nCpldCons + ! DO J=1,3 + ! y%PtFairleadLoad%Force(J,I) = m%ConnectList(m%CpldConIs(I))%Fnet(J) + ! END DO + ! END DO + + ! now that forces have been updated, write them to the output mesh + + do iTurb = 1,p%nTurbines + + 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) + y%CoupledLoads(iTurb)%Force( :,J) = F6net(1:3) + y%CoupledLoads(iTurb)%Moment(:,J) = F6net(4:6) END DO - END DO - + + DO l = 1,p%nCpldRods(iTurb) + J = J + 1 + CALL Rod_GetCoupledForce(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 + + DO l = 1,p%nCpldCons(iTurb) + J = J + 1 + CALL Connect_GetCoupledForce(m%ConnectList(m%CpldConIs(l,iTurb)), F6net(1:3), m, p) + y%CoupledLoads(iTurb)%Force(:,J) = F6net(1:3) + END DO + + end do + + ! ! write all node positions to the node positons output array (if water kinematics were passed in at each node in future) + ! ! 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 + ! calculate outputs (y%WriteOutput) for glue code and write any m outputs to MoorDyn output files - CALL MDIO_WriteOutputs(t, p, m, y, ErrStat2, ErrMsg2) + CALL MDIO_WriteOutputs(REAL(t,DbKi) , p, m, y, ErrStat2, ErrMsg2) CALL CheckError(ErrStat2, 'In MDIO_WriteOutputs: '//trim(ErrMsg2)) IF ( ErrStat >= AbortErrLev ) RETURN - ! destroy dxdt - CALL MD_DestroyContState( dxdt, ErrStat2, ErrMsg2) - CALL CheckError(ErrStat2, 'When destroying dxdt: '//trim(ErrMsg2)) - IF ( ErrStat >= AbortErrLev ) RETURN + ! ! destroy dxdt + ! CALL MD_DestroyContState( dxdt, ErrStat2, ErrMsg2) + ! CALL CheckError(ErrStat2, 'When destroying dxdt: '//trim(ErrMsg2)) + ! IF ( ErrStat >= AbortErrLev ) RETURN @@ -697,18 +2626,18 @@ SUBROUTINE CheckError(ErrId, Msg) CALL WrScr( ErrMsg ) ! do this always or only if warning level? <<<<<<<<<<<<<<<<<<<<<< probably should remove all instances - IF( ErrStat > ErrID_Warn ) THEN - CALL MD_DestroyContState( dxdt, ErrStat2, ErrMsg2) - END IF + ! IF( ErrStat > ErrID_Warn ) THEN + ! CALL MD_DestroyContState( dxdt, ErrStat2, ErrMsg2) + ! END IF END IF END SUBROUTINE CheckError END SUBROUTINE MD_CalcOutput - !============================================================================================= + !---------------------------------------------------------------------------------------- - !============================================================================================= + !---------------------------------------------------------------------------------------- SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, ErrMsg ) ! Tight coupling routine for computing derivatives of continuous states ! this is modelled off what used to be subroutine DoRHSmaster @@ -721,430 +2650,279 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er TYPE(MD_ConstraintStateType), INTENT(IN ) :: z ! Constraint states at t TYPE(MD_OtherStateType), INTENT(IN ) :: other ! Other states at t TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables - TYPE(MD_ContinuousStateType), INTENT( OUT) :: dxdt ! Continuous state derivatives at t + TYPE(MD_ContinuousStateType), INTENT(INOUT) :: 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 INTEGER(IntKi) :: L ! index + INTEGER(IntKi) :: I ! index INTEGER(IntKi) :: J ! index INTEGER(IntKi) :: K ! index + INTEGER(IntKi) :: iTurb ! index INTEGER(IntKi) :: Istart ! start index of line/connect in state vector INTEGER(IntKi) :: Iend ! end index of line/connect in state vector - + 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 + REAL(DbKi) :: a6_in(6) ! temporary for passing kinematics + REAL(DbKi) :: r_in(3) ! temporary for passing kinematics + REAL(DbKi) :: rd_in(3) ! temporary for passing kinematics + REAL(DbKi) :: a_in(3) ! temporary for passing kinematics + + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None + character(*), parameter :: RoutineName = 'MD_CalcContStateDeriv' + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - ! allocations of dxdt (as in SubDyn. "INTENT(OUT) automatically deallocates the arrays on entry, we have to allocate them here" is this right/efficient?) - ALLOCATE ( dxdt%states(size(x%states)), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating dxdt%states array.' - RETURN + ! allocate dxdt if not already allocated (e.g. if called for linearization) + IF (.NOT. ALLOCATED(dxdt%states) ) THEN + CALL AllocAry( dxdt%states, SIZE(x%states), 'dxdt%states', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN END IF - - ! clear connection force and mass values + ! clear connection force and mass values updateFairlead( t ); <<<< manually set anchored connection stuff for now here + r6_in = 0.0_DbKi + v6_in = 0.0_DbKi + CALL Body_SetKinematics(m%GroundBody, r6_in, v6_in, m%zeros6, t, m) + + ! ---------------------------------- coupled things --------------------------------- + ! Apply displacement and velocity terms here. Accelerations will be considered to calculate inertial loads at the end. + ! Note: TurbineRefPos is to offset into farm's true global reference based on turbine X and Y reference positions (these should be 0 for regular FAST use) + - ! update fairlead positions for instantaneous values (fixed 2015-06-22) - DO K = 1, p%NFairs - DO J = 1,3 - m%ConnectList(m%FairIdList(K))%r(J) = u%PtFairleadDisplacement%Position(J,K) + u%PtFairleadDisplacement%TranslationDisp(J,K) - m%ConnectList(m%FairIdList(K))%rd(J) = u%PtFairleadDisplacement%TranslationVel(J,K) ! is this right? <<< + DO iTurb = 1, p%nTurbines + + J = 0 ! J is the index of the coupling points in the input mesh CoupledKinematics + ! any coupled bodies (type -1) + 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 + 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) + a6_in(4:6) = u%CoupledKinematics(iTurb)%RotationAcc(:,J) + + CALL Body_SetKinematics(m%BodyList(m%CpldBodyIs(l,iTurb)), r6_in, v6_in, a6_in, t, m) END DO - END DO - + + ! any coupled rods (type -1 or -2) note, rotations ignored if it's a pinned rod + DO l = 1,p%nCpldRods(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) = MATMUL( u%CoupledKinematics(iTurb)%Orientation(:,:,J) , (/0.0, 0.0, 1.0/) ) ! <<<< CHECK ! adjustment because rod's rotational entries are a unit vector, q + 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) + a6_in(4:6) = u%CoupledKinematics(iTurb)%RotationAcc(:,J) + + CALL Rod_SetKinematics(m%RodList(m%CpldRodIs(l,iTurb)), r6_in, v6_in, a6_in, t, m) + + END DO + + ! any coupled points (type -1) + DO l = 1, p%nCpldCons(iTurb) + J = J + 1 + + r_in = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + rd_in = u%CoupledKinematics(iTurb)%TranslationVel(:,J) + a_in(1:3) = u%CoupledKinematics(iTurb)%TranslationAcc(:,J) + CALL Connect_SetKinematics(m%ConnectList(m%CpldConIs(l,iTurb)), r_in, rd_in, a_in, t, m) + + !print "(f8.5, f12.6, f12.6, f8.4, f8.4, f8.4, f8.4)", t, r_in(1), r_in(3), rd_in(1), rd_in(3), a_in(1), a_in(3) + + END DO + + end do ! iTurb + + + ! >>>>> in theory I would repeat the above but for each turbine in the case of array use here <<<<< + ! DO I = 1,p%nTurbines + ! J = 0? + ! other logic? + ! nvm: need to get kinematics from entries in u%FarmCoupledKinematics(I)%Position etc. + ! nvm: using knowledge of p%meshIndex or something + ! in theory might also support individual line tensioning control commands from turbines this way too, or maybe it's supercontroller level (not a short term problem though) + + ! apply line length changes from active tensioning if applicable DO L = 1, p%NLines IF (m%LineList(L)%CtrlChan > 0) then - + ! do a bounds check to prohibit excessive segment length changes (until a method to add/remove segments is created) IF ( u%DeltaL(m%LineList(L)%CtrlChan) > m%LineList(L)%UnstrLen / m%LineList(L)%N ) then ErrStat = ErrID_Fatal ErrMsg = ' Active tension command will make a segment longer than the limit of twice its original length.' - print *, u%DeltaL(m%LineList(L)%CtrlChan), " is an increase of more than ", (m%LineList(L)%UnstrLen / m%LineList(L)%N) - print *, u%DeltaL - print*, m%LineList(L)%CtrlChan + 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 (wordy > 0) print *, u%DeltaL + IF (wordy > 0) print*, m%LineList(L)%CtrlChan RETURN END IF IF ( u%DeltaL(m%LineList(L)%CtrlChan) < -0.5 * m%LineList(L)%UnstrLen / m%LineList(L)%N ) then ErrStat = ErrID_Fatal ErrMsg = ' Active tension command will make a segment shorter than the limit of half its original length.' - print *, u%DeltaL(m%LineList(L)%CtrlChan), " is a reduction of more than half of ", (m%LineList(L)%UnstrLen / m%LineList(L)%N) - print *, u%DeltaL - print*, m%LineList(L)%CtrlChan + 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 (wordy > 0) print *, u%DeltaL + IF (wordy > 0) print*, m%LineList(L)%CtrlChan RETURN END IF - + ! for now this approach only acts on the fairlead end segment, and assumes all segment lengths are otherwise equal size m%LineList(L)%l( m%LineList(L)%N) = m%LineList(L)%UnstrLen/m%LineList(L)%N + u%DeltaL(m%LineList(L)%CtrlChan) m%LineList(L)%ld(m%LineList(L)%N) = u%DeltaLdot(m%LineList(L)%CtrlChan) END IF END DO - - ! do Line force and acceleration calculations, also add end masses/forces to respective Connects - DO L = 1, p%NLines - Istart = m%LineStateIndList(L) - Iend = Istart + 6*(m%LineList(L)%N - 1) - 1 - CALL DoLineRHS(x%states(Istart:Iend), dxdt%states(Istart:Iend), t, m%LineList(L), & - m%LineTypeList(m%LineList(L)%PropsIdNum), & - m%ConnectList(m%LineList(L)%FairConnect)%Ftot, m%ConnectList(m%LineList(L)%FairConnect)%Mtot, & - m%ConnectList(m%LineList(L)%AnchConnect)%Ftot, m%ConnectList(m%LineList(L)%AnchConnect)%Mtot ) + + + ! ! go through nodes and apply wave kinematics from driver (if water kinematics were passed in at each node in future) + ! IF (p%WaterKin > 0) THEN + ! + ! J=0 + ! ! Body reference point coordinates + ! DO I = 1, p%nBodies + ! J = J + 1 + ! m%BodyList(I)%U = u%U(:,J) + ! m%BodyList(I)%Ud = u%Ud(:,J) + ! m%BodyList(I)%zeta = u%zeta(J) + ! END DO + ! ! Rod node coordinates + ! DO I = 1, p%nRods + ! DO K = 0,m%RodList(I)%N + ! J = J + 1 + ! m%RodList(I)%U (:,K) = u%U(:,J) + ! m%RodList(I)%Ud(:,K) = u%Ud(:,J) + ! m%RodList(I)%zeta(K) = u%zeta(J) + ! m%RodList(I)%PDyn(K) = u%PDyn(J) + ! END DO + ! END DO + ! ! Point reference point coordinates + ! DO I = 1, p%nConnects + ! J = J + 1 + ! m%ConnectList(I)%U = u%U(:,J) + ! m%ConnectList(I)%Ud = u%Ud(:,J) + ! m%ConnectList(I)%zeta = u%zeta(J) + ! END DO + ! ! Line internal node coordinates + ! DO I = 1, p%nLines + ! DO K = 1, m%LineList(I)%N-1 + ! J = J + 1 + ! m%LineList(I)%U (:,K) = u%U(:,J) + ! m%LineList(I)%Ud(:,K) = u%Ud(:,J) + ! m%LineList(I)%zeta(K) = u%zeta(J) + ! END DO + ! END DO + ! + ! END IF + + + ! independent or semi-independent things with their own states... + + ! give Bodies latest state variables (kinematics will also be assigned to dependent connections and rods, and thus line ends) + DO l = 1,p%nFreeBodies + CALL Body_SetState(m%BodyList(m%FreeBodyIs(l)), x%states(m%BodyStateIs1(l):m%BodyStateIsN(l)), t, m) END DO - - - ! perform connection force and mass calculations (done to all connects for sake of calculating fairlead/anchor loads) - DO L = 1, p%NConnects - ! add Connect's own forces including buoyancy and weight - m%ConnectList(L)%Ftot(1) =m%ConnectList(L)%Ftot(1) + m%ConnectList(L)%conFX - m%ConnectList(L)%Ftot(2) =m%ConnectList(L)%Ftot(2) + m%ConnectList(L)%conFY - m%ConnectList(L)%Ftot(3) =m%ConnectList(L)%Ftot(3) + m%ConnectList(L)%conFZ + m%ConnectList(L)%conV*p%rhoW*p%g - m%ConnectList(L)%conM*p%g - - ! add Connect's own mass - DO J = 1,3 - m%ConnectList(L)%Mtot(J,J) = m%ConnectList(L)%Mtot(J,J) + m%ConnectList(L)%conM - END DO - END DO ! L - - - ! do Connect acceleration calculations - changed to do only connect types - DO L = 1, p%NConns - Istart = L*6-5 - Iend = L*6 - CALL DoConnectRHS(x%states(Istart:Iend), dxdt%states(Istart:Iend), t, m%ConnectList(m%ConnIDList(L))) + + ! give independent or pinned rods' latest state variables (kinematics will also be assigned to attached line ends) + DO l = 1,p%nFreeRods + CALL Rod_SetState(m%RodList(m%FreeRodIs(l)), x%states(m%RodStateIs1(l):m%RodStateIsN(l)), t, m) END DO - - - CONTAINS - - - !====================================================================== - SUBROUTINE DoLineRHS (X, Xd, t, Line, LineProp, FairFtot, FairMtot, AnchFtot, AnchMtot) - - Real(DbKi), INTENT( IN ) :: X(:) ! state vector, provided - Real(DbKi), INTENT( INOUT ) :: Xd(:) ! derivative of state vector, returned ! cahnged to INOUT - Real(DbKi), INTENT (IN) :: t ! instantaneous time - TYPE(MD_Line), INTENT (INOUT) :: Line ! label for the current line, for convenience - TYPE(MD_LineProp), INTENT(IN) :: LineProp ! the single line property set for the line of interest - Real(DbKi), INTENT(INOUT) :: FairFtot(:) ! total force on Connect top of line is attached to - Real(DbKi), INTENT(INOUT) :: FairMtot(:,:) ! total mass of Connect top of line is attached to - Real(DbKi), INTENT(INOUT) :: AnchFtot(:) ! total force on Connect bottom of line is attached to - Real(DbKi), INTENT(INOUT) :: AnchMtot(:,:) ! total mass of Connect bottom of line is attached to - - - INTEGER(IntKi) :: I ! index of segments or nodes along line - INTEGER(IntKi) :: J ! index - INTEGER(IntKi) :: K ! index - INTEGER(IntKi) :: N ! number of segments in line - Real(DbKi) :: d ! line diameter - Real(DbKi) :: rho ! line material density [kg/m^3] - Real(DbKi) :: Sum1 ! for summing squares - Real(DbKi) :: m_i ! node mass - Real(DbKi) :: v_i ! node submerged volume - 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) :: SumSqVp ! - Real(DbKi) :: SumSqVq ! - Real(DbKi) :: MagVp ! - Real(DbKi) :: MagVq ! - - - N = Line%N ! for convenience - d = LineProp%d ! for convenience - rho = LineProp%w/(Pi/4.0*d*d) - - - - ! set end node positions and velocities from connect objects' states - DO J = 1, 3 - Line%r( J,N) = m%ConnectList(Line%FairConnect)%r(J) - Line%r( J,0) = m%ConnectList(Line%AnchConnect)%r(J) - Line%rd(J,N) = m%ConnectList(Line%FairConnect)%rd(J) - Line%rd(J,0) = m%ConnectList(Line%AnchConnect)%rd(J) - END DO - - ! set interior node positions and velocities - DO I = 1, N-1 - DO J = 1, 3 - Line%r( J,I) = X( 3*N-3 + 3*I-3 + J) ! r(J,I) = X[3*N-3 + 3*i-3 + J]; // get positions .. used to start from m%LineStateIndList(Line%IdNum) in whole state vector - Line%rd(J,I) = X( 3*I-3 + J) ! rd(J,I) = X[ 3*i-3 + J]; // get velocities - END DO - END DO - - ! calculate instantaneous (stretched) segment lengths and rates << should add catch here for if lstr is ever zero - DO I = 1, N - Sum1 = 0.0_DbKi - DO J = 1, 3 - Sum1 = Sum1 + (Line%r(J,I) - Line%r(J,I-1)) * (Line%r(J,I) - Line%r(J,I-1)) - END DO - Line%lstr(I) = sqrt(Sum1) ! stretched segment length - - Sum1 = 0.0_DbKi - DO J = 1, 3 - Sum1 = Sum1 + (Line%r(J,I) - Line%r(J,I-1))*(Line%rd(J,I) - Line%rd(J,I-1)) - END DO - Line%lstrd(I) = Sum1/Line%lstr(I) ! segment stretched length rate of change - - ! Line%V(I) = Pi/4.0 * d*d*Line%l(I) !volume attributed to segment - END DO - - !calculate unit tangent vectors (q) for each node (including ends) note: I think these are pointing toward 0 rather than N! - CALL UnitVector(Line%q(:,0), Line%r(:,1), Line%r(:,0)) ! compute unit vector q - DO I = 1, N-1 - CALL UnitVector(Line%q(:,I), Line%r(:,I+1), Line%r(:,I-1)) ! compute unit vector q ... using adjacent two nodes! - END DO - CALL UnitVector(Line%q(:,N), Line%r(:,N), Line%r(:,N-1)) ! compute unit vector q - - - ! wave kinematics not implemented yet - - - !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) - ELSE IF (I==N) THEN - m_i = pi/8.0 *d*d*Line%l(N)*rho; - v_i = 0.5*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)) - END IF - - DO J=1,3 - DO K=1,3 - IF (J==K) THEN - Line%M(K,J,I) = m_i + p%rhoW*v_i*( LineProp%Can*(1 - Line%q(J,I)*Line%q(K,I)) + LineProp%Cat*Line%q(J,I)*Line%q(K,I) ) - ELSE - Line%M(K,J,I) = p%rhoW*v_i*( LineProp%Can*(-Line%q(J,I)*Line%q(K,I)) + LineProp%Cat*Line%q(J,I)*Line%q(K,I) ) - END IF - END DO - END DO - - CALL Inverse3by3(Line%S(:,:,I), Line%M(:,:,I)) ! invert mass matrix - END DO - - - ! ------------------ CALCULATE FORCES ON EACH NODE ---------------------------- - - ! loop through the segments - DO I = 1, N - - ! line tension, inherently including possibility of dynamic length changes in l term - IF (Line%lstr(I)/Line%l(I) > 1.0) THEN - DO J = 1, 3 - Line%T(J,I) = LineProp%EA *( 1.0/Line%l(I) - 1.0/Line%lstr(I) ) * (Line%r(J,I)-Line%r(J,I-1)) - END DO - ELSE - DO J = 1, 3 - Line%T(J,I) = 0.0_DbKi ! cable can't "push" - END DO - END if - - ! line internal damping force based on line-specific BA value, including possibility of dynamic length changes in l and ld terms - DO J = 1, 3 - Line%Td(J,I) = Line%BA* ( Line%lstrd(I) - Line%lstr(I)*Line%ld(I)/Line%l(I) )/Line%l(I) * (Line%r(J,I)-Line%r(J,I-1)) / Line%lstr(I) - END DO - END DO - - - - ! loop through the nodes - DO I = 0, N - - !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 - ELSE IF (i==N) THEN - Line%W(3,I) = pi/8.0*d*d* Line%l(N)*(rho - 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 - END IF - - !relative flow velocities - DO J = 1, 3 - Vi(J) = 0.0 - Line%rd(J,I) ! relative flow velocity over node -- this is where wave velicites would be added - END DO - - ! decomponse relative flow into components - SumSqVp = 0.0_DbKi ! start sums of squares at zero - SumSqVq = 0.0_DbKi - DO J = 1, 3 - Vq(J) = DOT_PRODUCT( Vi , Line%q(:,I) ) * Line%q(J,I); ! tangential relative flow component - Vp(J) = Vi(J) - Vq(J) ! transverse relative flow component - SumSqVq = SumSqVq + Vq(J)*Vq(J) - SumSqVp = SumSqVp + Vp(J)*Vp(J) - END DO - MagVp = sqrt(SumSqVp) ! get magnitudes of flow components - MagVq = sqrt(SumSqVq) - - ! transverse and tangenential drag - IF (I==0) THEN - DO J = 1, 3 - Line%Dp(J,I) = 0.25*p%rhoW*LineProp%Cdn* d*Line%l(1) * MagVp * Vp(J) - Line%Dq(J,I) = 0.25*p%rhoW*LineProp%Cdt* Pi*d*Line%l(1) * MagVq * Vq(J) - END DO - ELSE IF (I==N) THEN - DO J = 1, 3 - Line%Dp(J,I) = 0.25*p%rhoW*LineProp%Cdn* d*Line%l(N) * MagVp * Vp(J); - Line%Dq(J,I) = 0.25*p%rhoW*LineProp%Cdt* Pi*d*Line%l(N) * MagVq * Vq(J) - END DO - ELSE - DO J = 1, 3 - Line%Dp(J,I) = 0.25*p%rhoW*LineProp%Cdn* d*(Line%l(I) + Line%l(I+1)) * MagVp * vp(J); - Line%Dq(J,I) = 0.25*p%rhoW*LineProp%Cdt* Pi*d*(Line%l(I) + Line%l(I+1)) * MagVq * vq(J); - END DO - END IF - - ! F-K force from fluid acceleration not implemented yet - - ! 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 - - IF (Line%r(3,I) < -p%WtrDpth) THEN - IF (I==0) THEN - Line%B(3,I) = ( (-p%WtrDpth - Line%r(3,I))*p%kBot - Line%rd(3,I)*p%cBot) * 0.5*d*( Line%l(I+1) ) - ELSE IF (I==N) THEN - Line%B(3,I) = ( (-p%WtrDpth - Line%r(3,I))*p%kBot - Line%rd(3,I)*p%cBot) * 0.5*d*(Line%l(I) ) - ELSE - Line%B(3,I) = ( (-p%WtrDpth - Line%r(3,I))*p%kBot - Line%rd(3,I)*p%cBot) * 0.5*d*(Line%l(I) + Line%l(I+1) ) - - - - END IF - ELSE - Line%B(3,I) = 0.0_DbKi - END IF - - ! total forces - IF (I==0) THEN - DO J = 1, 3 - Line%F(J,I) = Line%T(J,1) + Line%Td(J,1) + Line%W(J,I) + Line%Dp(J,I) + Line%Dq(J,I) + Line%B(J,I) - END DO - ELSE IF (I==N) THEN - DO J = 1, 3 - Line%F(J,I) = -Line%T(J,N) - Line%Td(J,N) + Line%W(J,I) + Line%Dp(J,I) + Line%Dq(J,I) + Line%B(J,I) - END DO - ELSE - DO J = 1, 3 - Line%F(J,I) = Line%T(J,I+1) - Line%T(J,I) + Line%Td(J,I+1) - Line%Td(J,I) + Line%W(J,I) + Line%Dp(J,I) + Line%Dq(J,I) + Line%B(J,I) - END DO - END IF - - END DO ! I - done looping through nodes - - - ! loop through internal nodes and update their states - DO I=1, N-1 - DO J=1,3 - - ! calculate RHS constant (premultiplying force vector by inverse of mass matrix ... i.e. rhs = S*Forces) - Sum1 = 0.0_DbKi ! reset temporary accumulator - DO K = 1, 3 - Sum1 = Sum1 + Line%S(K,J,I) * Line%F(K,I) ! matrix-vector multiplication [S i]{Forces i} << double check indices - END DO ! K - - ! update states - Xd(3*N-3 + 3*I-3 + J) = X(3*I-3 + J); ! dxdt = V (velocities) - Xd( 3*I-3 + J) = Sum1 ! dVdt = RHS * A (accelerations) - - END DO ! J - END DO ! I - - - ! add force and mass of end nodes to the Connects they correspond to - DO J = 1,3 - FairFtot(J) = FairFtot(J) + Line%F(J,N) - AnchFtot(J) = AnchFtot(J) + Line%F(J,0) - DO K = 1,3 - FairMtot(K,J) = FairMtot(K,J) + Line%M(K,J,N) - AnchMtot(K,J) = AnchMtot(K,J) + Line%M(K,J,0) - END DO - END DO - - END SUBROUTINE DoLineRHS - !===================================================================== - - - !====================================================================== - SUBROUTINE DoConnectRHS (X, Xd, t, Connect) - - ! This subroutine is for the "Connect" type of Connections only. Other types don't have their own state variables. - Real(DbKi), INTENT( IN ) :: X(:) ! state vector for this connect, provided - Real(DbKi), INTENT( OUT ) :: Xd(:) ! derivative of state vector for this connect, returned - Real(DbKi), INTENT (IN) :: t ! instantaneous time - Type(MD_Connect), INTENT (INOUT) :: Connect ! Connect number - - - !INTEGER(IntKi) :: I ! index of segments or nodes along line - INTEGER(IntKi) :: J ! index - INTEGER(IntKi) :: K ! index - Real(DbKi) :: Sum1 ! for adding things - - ! When this sub is called, the force and mass contributions from the attached Lines should already have been added to - ! Fto and Mtot by the Line RHS function. Also, any self weight, buoyancy, or external forcing should have already been - ! added by the calling subroutine. The only thing left is any added mass or drag forces from the connection (e.g. float) - ! itself, which will be added below. - - - IF (EqualRealNos(t, 0.0_DbKi)) THEN ! this is old: with current IC gen approach, we skip the first call to the line objects, because they're set AFTER the call to the connects + ! give Connects (independent connections) latest state variable values (kinematics will also be assigned to attached line ends) + DO l = 1,p%nFreeCons + ! Print *, "calling SetState for free connection, con#", m%FreeConIs(l), " with state range: ", m%ConStateIs1(l), "-", m%ConStateIsN(l) + !K=K+1 + CALL Connect_SetState(m%ConnectList(m%FreeConIs(l)), x%states(m%ConStateIs1(l):m%ConStateIsN(l)), t, m) + END DO + + ! give Lines latest state variable values for internal nodes + DO l = 1,p%nLines + CALL Line_SetState(m%LineList(l), x%states(m%LineStateIs1(l):m%LineStateIsN(l)), t) + END DO - DO J = 1,3 - Xd(3+J) = X(J) ! velocities - these are unused in integration - Xd(J) = 0.0_DbKi ! accelerations - these are unused in integration - END DO - ELSE - ! from state values, get r and rdot values - DO J = 1,3 - Connect%r(J) = X(3 + J) ! get positions - Connect%rd(J) = X(J) ! get velocities - END DO - END IF + ! calculate dynamics of free objects (will also calculate forces (doRHS()) from any child/dependent objects)... - - ! add any added mass and drag forces from the Connect body itself - DO J = 1,3 - Connect%Ftot(J) = Connect%Ftot(J) - 0.5 * p%rhoW * Connect%rd(J) * abs(Connect%rd(J)) * Connect%conCdA; ! add drag forces - corrected Nov 24 - Connect%Mtot(J,J) = Connect%Mtot(J,J) + Connect%conV*p%rhoW*Connect%conCa; ! add added mass + ! calculate line dynamics (and calculate line forces and masses attributed to connections) + 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 + END DO + + ! calculate connect dynamics (including contributions from attached lines + ! as well as hydrodynamic forces etc. on connect object itself if applicable) + DO l = 1,p%nFreeCons + CALL Connect_GetStateDeriv(m%ConnectList(m%FreeConIs(l)), dxdt%states(m%ConStateIs1(l):m%ConStateIsN(l)), m, p) + END DO + + ! calculate dynamics of independent Rods + DO l = 1,p%nFreeRods + CALL Rod_GetStateDeriv(m%RodList(m%FreeRodIs(l)), dxdt%states(m%RodStateIs1(l):m%RodStateIsN(l)), m, p) + END DO + + ! calculate dynamics of Bodies + DO l = 1,p%nFreeBodies + CALL Body_GetStateDeriv(m%BodyList(m%FreeBodyIs(l)), dxdt%states(m%BodyStateIs1(l):m%BodyStateIsN(l)), m, p) + END DO + + + + ! get dynamics/forces (doRHS()) of coupled objects, which weren't addressed in above calls (this includes inertial loads) + ! note: can do this in any order since there are no dependencies among coupled objects + + DO iTurb = 1,p%nTurbines + DO l = 1,p%nCpldCons(iTurb) + + ! >>>>>>>> here we should pass along accelerations and include inertial loads in the calculation!!! << 0_IntKi) CLOSE( p%UnLog ) ! close log file if it's open + !TODO: any need to specifically deallocate things like m%xTemp%states in the above? <<<< ! IF ( ErrStat==ErrID_None) THEN ! CALL WrScr('MoorDyn closed without errors') @@ -1219,30 +3000,83 @@ SUBROUTINE CheckError(ErrId, Msg) END SUBROUTINE CheckError - END SUBROUTINE MD_End ! -------+ - !========================================================================================================== + END SUBROUTINE MD_End ! -------+ + !----------------------------------------------------------------------------------------================== + + +!!========== MD_CheckError ======= <---------------------------------------------------------------+ +! SUBROUTINE MD_CheckError(InMsg,OutMsg) +! ! Passed arguments +!! CHARACTER(*), INTENT(IN ) :: InMsg ! The input string +! CHARACTER(*), INTENT(INOUT) :: OutMsg ! The error message (ErrMsg)! +! + ! OutMsg = InMsg + ! RETURN + !END SUBROUTINE MD_CheckError ! -------+ + !----------------------------------------------------------------------------------------================== + + + ! RK2 integrater (part of what was in TimeStep) + !-------------------------------------------------------------- + SUBROUTINE MD_RK2 ( t, dtM, u_interp, u, t_array, p, x, xd, z, other, m, ErrStat, ErrMsg ) + + REAL(DbKi) , INTENT(INOUT) :: t ! intial time (s) for this integration step + REAL(DbKi) , INTENT(IN ) :: dtM ! single time step size (s) for this integration step + TYPE( MD_InputType ) , INTENT(INOUT) :: u_interp ! interpolated instantaneous input values to be calculated for each mooring time step + TYPE( MD_InputType ) , INTENT(INOUT) :: u(:) ! INTENT(IN ) + REAL(DbKi) , INTENT(IN ) :: t_array(:) ! times corresponding to elements of u(:)? + TYPE( MD_ParameterType ) , INTENT(IN ) :: p ! INTENT(IN ) + TYPE( MD_ContinuousStateType ) , INTENT(INOUT) :: x + TYPE( MD_DiscreteStateType ) , INTENT(IN ) :: xd ! INTENT(IN ) + TYPE( MD_ConstraintStateType ) , INTENT(IN ) :: z ! INTENT(IN ) + TYPE( MD_OtherStateType ) , INTENT(IN ) :: other ! INTENT(INOUT) + TYPE(MD_MiscVarType) , INTENT(INOUT) :: m ! INTENT(INOUT) + INTEGER(IntKi) , INTENT( OUT) :: ErrStat + CHARACTER(*) , INTENT( OUT) :: ErrMsg + + + INTEGER(IntKi) :: I ! counter + INTEGER(IntKi) :: J ! counter + + + ! ------------------------------------------------------------------------------- + ! RK2 integrator written here, now calling CalcContStateDeriv + !-------------------------------------------------------------------------------- + + ! step 1 + + CALL MD_Input_ExtrapInterp(u, t_array, u_interp, t , ErrStat, ErrMsg) ! interpolate input mesh to correct time (t) + + CALL MD_CalcContStateDeriv( t, u_interp, p, x, xd, z, other, m, m%xdTemp, ErrStat, ErrMsg ) + DO J = 1, m%Nx + m%xTemp%states(J) = x%states(J) + 0.5*dtM*m%xdTemp%states(J) !x1 = x0 + dt*f0/2.0; + END DO + ! step 2 -!!========== MD_CheckError ======= <---------------------------------------------------------------+ -! SUBROUTINE MD_CheckError(InMsg,OutMsg) -! ! Passed arguments -!! CHARACTER(*), INTENT(IN ) :: InMsg ! The input string -! CHARACTER(*), INTENT(INOUT) :: OutMsg ! The error message (ErrMsg)! -! - ! OutMsg = InMsg - ! RETURN - !END SUBROUTINE MD_CheckError ! -------+ - !========================================================================================================== + CALL MD_Input_ExtrapInterp(u, t_array, u_interp, t + 0.5_DbKi*dtM, ErrStat, ErrMsg) ! interpolate input mesh to correct time (t+0.5*dtM) + + CALL MD_CalcContStateDeriv( (t + 0.5_DbKi*dtM), u_interp, p, m%xTemp, xd, z, other, m, m%xdTemp, ErrStat, ErrMsg ) !called with updated states x2 and time = t + dt/2.0 + DO J = 1, m%Nx + x%states(J) = x%states(J) + dtM*m%xdTemp%states(J) + END DO + t = t + dtM ! update time + + !TODO error check? <<<< + END SUBROUTINE MD_RK2 + !-------------------------------------------------------------- - !======================================================================================================== - SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrMsg ) + !----------------------------------------------------------------------------------------================ + ! this would do a full (coupling) time step and is no longer used + SUBROUTINE TimeStep ( t, dtStep, u, t_array, p, x, xd, z, other, m, ErrStat, ErrMsg ) + REAL(DbKi) , INTENT(INOUT) :: t - REAL(ReKi) , INTENT(IN ) :: dtStep ! how long to advance the time for + REAL(DbKi) , INTENT(IN ) :: dtStep ! how long to advance the time for TYPE( MD_InputType ) , INTENT(INOUT) :: u(:) ! INTENT(IN ) - REAL(DbKi) , INTENT(IN ) :: utimes(:) ! times corresponding to elements of u(:)? + REAL(DbKi) , INTENT(IN ) :: t_array(:) ! times corresponding to elements of u(:)? TYPE( MD_ParameterType ) , INTENT(IN ) :: p ! INTENT(IN ) TYPE( MD_ContinuousStateType ) , INTENT(INOUT) :: x TYPE( MD_DiscreteStateType ) , INTENT(IN ) :: xd ! INTENT(IN ) @@ -1262,7 +3096,7 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM INTEGER(IntKi) :: J ! counter TYPE(MD_InputType) :: u_interp ! interpolated instantaneous input values to be calculated for each mooring time step - Real(DbKi) :: tDbKi ! double version because that's what MD_Input_ExtrapInterp needs. + ! Real(DbKi) :: tDbKi ! double version because that's what MD_Input_ExtrapInterp needs. ! allocate space for x2 @@ -1272,19 +3106,19 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM CALL MD_CopyInput(u(1), u_interp, MESH_NEWCOPY, ErrStat, ErrMsg) - Nx = size(x%states) + Nx = size(x%states) ! <<<< should this be the m%Nx parameter instead? ! round dt to integer number of time steps NdtM = ceiling(dtStep/p%dtM0) ! get number of mooring time steps to do based on desired time step size - dtM = dtStep/float(NdtM) ! adjust desired time step to satisfy dt with an integer number of time steps + dtM = dtStep/REAL(NdtM,DbKi) ! adjust desired time step to satisfy dt with an integer number of time steps !loop through line integration time steps DO I = 1, NdtM ! for (double ts=t; ts<=t+ICdt-dts; ts+=dts) - !tDbKi = t ! get DbKi version of current time (why does ExtrapInterp except different time type than UpdateStates?) + ! tDbKi = t ! get DbKi version of current time (why does ExtrapInterp except different time type than UpdateStates?) ! ------------------------------------------------------------------------------- @@ -1293,7 +3127,7 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM ! step 1 - CALL MD_Input_ExtrapInterp(u, utimes, u_interp, t , ErrStat, ErrMsg) ! interpolate input mesh to correct time (t) + CALL MD_Input_ExtrapInterp(u, t_array, u_interp, t , ErrStat, ErrMsg) ! interpolate input mesh to correct time (t) CALL MD_CalcContStateDeriv( t, u_interp, p, x, xd, z, other, m, dxdt, ErrStat, ErrMsg ) DO J = 1, Nx @@ -1302,7 +3136,7 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM ! step 2 - CALL MD_Input_ExtrapInterp(u, utimes, u_interp, t + 0.5_DbKi*dtM, ErrStat, ErrMsg) ! interpolate input mesh to correct time (t+0.5*dtM) + CALL MD_Input_ExtrapInterp(u, t_array, u_interp, t + 0.5_DbKi*dtM, ErrStat, ErrMsg) ! interpolate input mesh to correct time (t+0.5*dtM) CALL MD_CalcContStateDeriv( (t + 0.5_DbKi*dtM), u_interp, p, x2, xd, z, other, m, dxdt, ErrStat, ErrMsg ) !called with updated states x2 and time = t + dt/2.0 DO J = 1, Nx @@ -1310,16 +3144,14 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM END DO t = t + dtM ! update time - - !print *, " In TimeStep t=", t, ", L1N8Pz=", M%LineList(1)%r(3,8), ", dL1=", u_interp%DeltaL(1) !---------------------------------------------------------------------------------- ! >>> below should no longer be necessary thanks to using ExtrapInterp of u(:) within the mooring time stepping loop.. <<< ! ! update Fairlead positions by integrating velocity and last position (do this AFTER the processing of the time step rather than before) - ! DO J = 1, p%NFairs + ! DO J = 1, p%nCpldCons ! DO K = 1, 3 - ! m%ConnectList(m%FairIdList(J))%r(K) = m%ConnectList(m%FairIdList(J))%r(K) + m%ConnectList(m%FairIdList(J))%rd(K)*dtM + ! m%ConnectList(m%CpldConIs(J))%r(K) = m%ConnectList(m%CpldConIs(J))%r(K) + m%ConnectList(m%CpldConIs(J))%rd(K)*dtM ! END DO ! END DO @@ -1339,7 +3171,7 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM ! check for NaNs - is this a good place/way to do it? DO J = 1, Nx - IF (Is_NaN(REAL(x%states(J),DbKi))) THEN + IF (Is_NaN(x%states(J))) THEN ErrStat = ErrID_Fatal ErrMsg = ' NaN state detected.' END IF @@ -1347,880 +3179,904 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM END SUBROUTINE TimeStep - !====================================================================== - - - - !======================================================================= - SUBROUTINE SetupLine (Line, LineProp, rhoW, ErrStat, ErrMsg) - ! allocate arrays in line object - - TYPE(MD_Line), INTENT(INOUT) :: Line ! the single line object of interest - TYPE(MD_LineProp), INTENT(INOUT) :: LineProp ! the single line property set for the line of interest - REAL(ReKi), INTENT(IN) :: rhoW - 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) :: J ! Generic index - INTEGER(4) :: K ! Generic index - INTEGER(IntKi) :: N - - N = Line%N ! number of segments in this line (for code readability) - - ! allocate node positions and velocities (NOTE: these arrays start at ZERO) - ALLOCATE ( Line%r(3, 0:N), Line%rd(3, 0:N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating r and rd arrays.' - !CALL CleanUp() - RETURN - END IF - - ! allocate node tangent vectors - ALLOCATE ( Line%q(3, 0:N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating q array.' - !CALL CleanUp() - RETURN - END IF - - ! allocate segment scalar quantities - ALLOCATE ( Line%l(N), Line%ld(N), Line%lstr(N), Line%lstrd(N), Line%V(N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating segment scalar quantity arrays.' - !CALL CleanUp() - RETURN - END IF - - ! assign values for l and V - DO J=1,N - Line%l(J) = Line%UnstrLen/REAL(N, DbKi) - Line%ld(J)= 0.0_DbKi - Line%V(J) = Line%l(J)*0.25*Pi*LineProp%d*LineProp%d - END DO - - ! allocate segment tension and internal damping force vectors - ALLOCATE ( Line%T(3, N), Line%Td(3, N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating T and Td arrays.' - !CALL CleanUp() - RETURN - END IF - - ! allocate node force vectors - ALLOCATE ( Line%W(3, 0:N), Line%Dp(3, 0:N), Line%Dq(3, 0:N), Line%Ap(3, 0:N), & - Line%Aq(3, 0:N), Line%B(3, 0:N), Line%F(3, 0:N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating node force arrays.' - !CALL CleanUp() - RETURN - END IF - - ! set gravity and bottom contact forces to zero initially (because the horizontal components should remain at zero) - DO J = 0,N - DO K = 1,3 - Line%W(K,J) = 0.0_DbKi - Line%B(K,J) = 0.0_DbKi - END DO - END DO - - ! allocate mass and inverse mass matrices for each node (including ends) - ALLOCATE ( Line%S(3, 3, 0:N), Line%M(3, 3, 0:N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating T and Td arrays.' - !CALL CleanUp() - RETURN - END IF - - ! Specify specific internal damping coefficient (BA) for this line. - ! Will be equal to inputted BA of LineType if input value is positive. - ! If input value is negative, it is considered to be desired damping ratio (zeta) - ! from which the line's BA can be calculated based on the segment natural frequency. - IF (LineProp%BA < 0) THEN - ! - we assume desired damping coefficient is zeta = -LineProp%BA - ! - highest axial vibration mode of a segment is wn = sqrt(k/m) = 2N/UnstrLen*sqrt(EA/w) - Line%BA = -LineProp%BA * Line%UnstrLen / Line%N * SQRT(LineProp%EA * LineProp%w) - ! print *, 'Based on zeta, BA set to ', Line%BA - - ! print *, 'Negative BA input detected, treating as -zeta. For zeta = ', -LineProp%BA, ', setting BA to ', Line%BA - - ELSE - Line%BA = LineProp%BA - ! temp = Line%N * Line%BA / Line%UnstrLen * SQRT(1.0/(LineProp%EA * LineProp%w)) - ! print *, 'BA set as input to ', Line%BA, '. Corresponding zeta is ', temp - END IF - - !temp = 2*Line%N / Line%UnstrLen * sqrt( LineProp%EA / LineProp%w) / TwoPi - !print *, 'Segment natural frequency is ', temp, ' Hz' - - - ! need to add cleanup sub <<< - - - END SUBROUTINE SetupLine - !====================================================================== - - - - - !=============================================================================================== - SUBROUTINE InitializeLine (Line, LineProp, rhoW, ErrStat, ErrMsg) - ! calculate initial profile of the line using quasi-static model - - TYPE(MD_Line), INTENT(INOUT) :: Line ! the single line object of interest - TYPE(MD_LineProp), INTENT(INOUT) :: LineProp ! the single line property set for the line of interest - REAL(ReKi), INTENT(IN) :: rhoW - INTEGER, INTENT( INOUT ) :: ErrStat ! returns a non-zero value when an error occurs - CHARACTER(*), INTENT( INOUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - REAL(DbKi) :: COSPhi ! Cosine of the angle between the xi-axis of the inertia frame and the X-axis of the local coordinate system of the current mooring line (-) - REAL(DbKi) :: SINPhi ! Sine of the angle between the xi-axis of the inertia frame and the X-axis of the local coordinate system of the current mooring line (-) - REAL(DbKi) :: XF ! Horizontal distance between anchor and fairlead of the current mooring line (meters) - REAL(DbKi) :: ZF ! Vertical distance between anchor and fairlead of the current mooring line (meters) - INTEGER(4) :: I ! Generic index - INTEGER(4) :: J ! Generic index - - - INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None - REAL(DbKi) :: WetWeight - REAL(DbKi) :: SeabedCD = 0.0_DbKi - REAL(DbKi) :: TenTol = 0.0001_DbKi - REAL(DbKi), ALLOCATABLE :: LSNodes(:) - REAL(DbKi), ALLOCATABLE :: LNodesX(:) - REAL(DbKi), ALLOCATABLE :: LNodesZ(:) - INTEGER(IntKi) :: N + !-------------------------------------------------------------- - N = Line%N ! for convenience - ! try to calculate initial line profile using catenary routine (from FAST v.7) - ! note: much of this function is adapted from the FAST source code +!-------------------------------------------------------------- +! Connection-Specific Subroutines +!-------------------------------------------------------------- - ! Transform the fairlead location from the inertial frame coordinate system - ! to the local coordinate system of the current line (this coordinate - ! system lies at the current anchor, Z being vertical, and X directed from - ! current anchor to the current fairlead). Also, compute the orientation - ! of this local coordinate system: - XF = SQRT( ( Line%r(1,N) - Line%r(1,0) )**2.0 + ( Line%r(2,N) - Line%r(2,0) )**2.0 ) - ZF = Line%r(3,N) - Line%r(3,0) - IF ( XF == 0.0 ) THEN ! .TRUE. if the current mooring line is exactly vertical; thus, the solution below is ill-conditioned because the orientation is undefined; so set it such that the tensions and nodal positions are only vertical - COSPhi = 0.0_DbKi - SINPhi = 0.0_DbKi - ELSE ! The current mooring line must not be vertical; use simple trigonometry - COSPhi = ( Line%r(1,N) - Line%r(1,0) )/XF - SINPhi = ( Line%r(2,N) - Line%r(2,0) )/XF - ENDIF - WetWeight = LineProp%w - 0.25*Pi*LineProp%d*LineProp%d*rhoW +!-------------------------------------------------------------- +! Rod-Specific Subroutines +!-------------------------------------------------------------- - !LineNodes = Line%N + 1 ! number of nodes in line for catenary model to worry about - ! allocate temporary arrays for catenary routine - ALLOCATE ( LSNodes(N+1), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating LSNodes array.' - CALL CleanUp() - RETURN - END IF - ALLOCATE ( LNodesX(N+1), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating LNodesX array.' - CALL CleanUp() - RETURN - END IF - ALLOCATE ( LNodesZ(N+1), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating LNodesZ array.' - CALL CleanUp() - RETURN - END IF - ! Assign node arc length locations - LSNodes(1) = 0.0_DbKi - DO I=2,N - LSNodes(I) = LSNodes(I-1) + Line%l(I-1) ! note: l index is because line segment indices start at 1 - END DO - LSNodes(N+1) = Line%UnstrLen ! ensure the last node length isn't longer than the line due to numerical error - - ! Solve the analytical, static equilibrium equations for a catenary (or - ! taut) mooring line with seabed interaction in order to find the - ! horizontal and vertical tensions at the fairlead in the local coordinate - ! system of the current line: - ! NOTE: The values for the horizontal and vertical tensions at the fairlead - ! from the previous time step are used as the initial guess values at - ! at this time step (because the LAnchHTe(:) and LAnchVTe(:) arrays - ! are stored in a module and thus their values are saved from CALL to - ! CALL). - - - CALL Catenary ( XF , ZF , Line%UnstrLen, LineProp%EA , & - WetWeight , SeabedCD, TenTol, (N+1) , & - LSNodes, LNodesX, LNodesZ , ErrStat2, ErrMsg2) - IF (ErrStat2 == ErrID_None) THEN ! if it worked, use it - ! Transform the positions of each node on the current line from the local - ! coordinate system of the current line to the inertial frame coordinate - ! system: - DO J = 0,Line%N ! Loop through all nodes per line where the line position and tension can be output - Line%r(1,J) = Line%r(1,0) + LNodesX(J+1)*COSPhi - Line%r(2,J) = Line%r(2,0) + LNodesX(J+1)*SINPhi - Line%r(3,J) = Line%r(3,0) + LNodesZ(J+1) - ENDDO ! J - All nodes per line where the line position and tension can be output +!-------------------------------------------------------------- +! Body-Specific Subroutines +!-------------------------------------------------------------- - ELSE ! if there is a problem with the catenary approach, just stretch the nodes linearly between fairlead and anchor - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'InitializeLine') - DO J = 0,Line%N ! Loop through all nodes per line where the line position and tension can be output - Line%r(1,J) = Line%r(1,0) + (Line%r(1,N) - Line%r(1,0))*REAL(J, DbKi)/REAL(N, DbKi) - 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) - ENDDO - ENDIF +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! ###### The following four routines are Jacobian routines for linearization capabilities ####### +! If the module does not implement them, set ErrStat = ErrID_Fatal in SD_Init() when InitInp%Linearize is .true. +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. +SUBROUTINE MD_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(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(MD_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(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) wrt the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) wrt the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) wrt the inputs (u) [intent in to avoid deallocation] + + ! local variables + TYPE(MD_OutputType) :: y_m, y_p + TYPE(MD_ContinuousStateType) :: x_m, x_p + TYPE(MD_InputType) :: u_perturb + REAL(R8Ki) :: delta_p, delta_m ! delta change in input (plus, minus) + INTEGER(IntKi) :: i + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_JacobianPInput' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + ! get OP values here: + call MD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if(Failed()) return + + ! make a copy of the inputs to perturb + call MD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + + IF ( PRESENT( dYdu ) ) THEN + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (.not. allocated(dYdu) ) then + call AllocAry(dYdu, p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2); if(Failed()) return + end if + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call MD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + call MD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + do i=1,size(p%Jac_u_indx,1) + ! get u_op + delta_p u + call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_Perturb_u( p, i, 1, u_perturb, delta_p ) + ! compute y at u_op + delta_p u + call MD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! get u_op - delta_m u + call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_Perturb_u( p, i, -1, u_perturb, delta_m ) + ! compute y at u_op - delta_m u + call MD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! get central difference: + call MD_Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) + end do + if(Failed()) return + END IF + IF ( PRESENT( dXdu ) ) THEN + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, p%Jac_nx, size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + endif + do i=1,size(p%Jac_u_indx,1) + ! get u_op + delta u + call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_Perturb_u( p, i, 1, u_perturb, delta_p ) + ! compute x at u_op + delta u + call MD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! get u_op - delta u + call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_Perturb_u( p, i, -1, u_perturb, delta_m ) + ! compute x at u_op - delta u + call MD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! get central difference: + ! we may have had an error allocating memory, so we'll check + if(Failed()) return + ! get central difference (state entries are mapped the the dXdu column in routine): + call MD_Compute_dX( p, x_p, x_m, delta_p, dXdu(:,i) ) + end do + END IF ! dXdu + IF ( PRESENT( dXddu ) ) THEN + if (allocated(dXddu)) deallocate(dXddu) + END IF + IF ( PRESENT( dZdu ) ) THEN + if (allocated(dZdu)) deallocate(dZdu) + END IF + call CleanUp() +contains + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + + subroutine CleanUp() + call MD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more + call MD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more + call MD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) + call MD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) + call MD_DestroyInput(u_perturb, ErrStat2, ErrMsg2 ) + end subroutine cleanup + +END SUBROUTINE MD_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 MD_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(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(MD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); Output fields are not used by this routine, but type is available here so that mesh parameter information (i.e., connectivity) does not have to be recalculated for dYdx. + TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions wrt the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) wrt the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) wrt the continuous states (x) [intent in to avoid deallocation] + ! local variables + TYPE(MD_OutputType) :: y_p, y_m + TYPE(MD_ContinuousStateType) :: x_p, x_m + TYPE(MD_ContinuousStateType) :: x_perturb + REAL(R8Ki) :: delta ! delta change in input or state + INTEGER(IntKi) :: i, k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_JacobianPContState' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + ! make a copy of the continuous states to perturb NOTE: MESH_NEWCOPY + call MD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + + IF ( PRESENT( dYdx ) ) THEN + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (.not. allocated(dYdx)) then + call AllocAry(dYdx, p%Jac_ny, p%Jac_nx, '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 MD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + ! Loop over the dx dimension of the dYdx array. Perturb the corresponding state (note difference in ordering of dYdx and x%states). + ! The p%dxIdx_map2_xStateIdx(i) is the index to the state array for the given dx index + 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 ) + ! 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 ) + ! 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: + call MD_Compute_dY( p, y_p, y_m, delta, dYdx(:,i) ) + end do + if(Failed()) return + END IF + + IF ( PRESENT( dXdx ) ) THEN + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if (.not. allocated(dXdx)) then + call AllocAry(dXdx, p%Jac_nx, p%Jac_nx, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return + end if + ! Loop over the dx dimension of the array. Perturb the corresponding state (note difference in ordering of dXdx and x%states). + ! The resulting x_p and x_m are used to calculate the column for dXdx (mapping of state entry to dXdx row entry occurs in MD_Compute_dX) + ! The p%dxIdx_map2_xStateIdx(i) is the index to the state array for the given dx index + 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 ) + ! 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 ) + ! 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 + ! get central difference: + call MD_Compute_dX( p, x_p, x_m, delta, dXdx(:,i) ) + end do + END IF + IF ( PRESENT( dXddx ) ) THEN + if (allocated(dXddx)) deallocate(dXddx) + END IF + IF ( PRESENT( dZdx ) ) THEN + if (allocated(dZdx)) deallocate(dZdx) + END IF + call CleanUp() + +contains + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_JacobianPContState') + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + + subroutine CleanUp() + call MD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) + call MD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) + call MD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) + call MD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) + call MD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) + end subroutine cleanup + +END SUBROUTINE MD_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 MD_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(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(MD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); Output fields are not used by this routine, but type is available here so that mesh parameter information (i.e., connectivity) does not have to be recalculated for dYdx. + TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions (Y) wrt the discrete states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state functions (X) wrt the discrete states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state functions (Xd) wrt the discrete states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state functions (Z) wrt discrete states (xd) [intent in to avoid deallocation] + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + IF ( PRESENT( dYdxd ) ) THEN + END IF + IF ( PRESENT( dXdxd ) ) THEN + END IF + IF ( PRESENT( dXddxd ) ) THEN + END IF + IF ( PRESENT( dZdxd ) ) THEN + END IF +END SUBROUTINE MD_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 MD_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(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(MD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); Output fields are not used by this routine, but type is available here so that mesh parameter information (i.e., connectivity) does not have to be recalculated for dYdx. + TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output functions (Y) with respect to the constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous state functions (X) with respect to the constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the constraint states (z) [intent in to avoid deallocation] + ! local variables + character(*), parameter :: RoutineName = 'MD_JacobianPConstrState' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + IF ( PRESENT( dYdz ) ) THEN + END IF + IF ( PRESENT( dXdz ) ) THEN + if (allocated(dXdz)) deallocate(dXdz) + END IF + IF ( PRESENT( dXddz ) ) THEN + if (allocated(dXddz)) deallocate(dXddz) + END IF + IF ( PRESENT(dZdz) ) THEN + END IF +END SUBROUTINE MD_JacobianPConstrState +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!> Routine to pack the data structures representing the operating points into arrays for linearization. +SUBROUTINE MD_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(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(MD_OutputType), INTENT(IN ) :: y !< Output at operating point + TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + ! Local + INTEGER(IntKi) :: idx, i + INTEGER(IntKi) :: nu + INTEGER(IntKi) :: ny + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_GetOP' + LOGICAL :: FieldMask(FIELDMASK_SIZE) + TYPE(MD_ContinuousStateType) :: dx ! derivative of continuous states at operating point + ErrStat = ErrID_None + ErrMsg = '' + ! inputs + IF ( PRESENT( u_op ) ) THEN + nu = size(p%Jac_u_indx,1) + u%CoupledKinematics(1)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + if (.not. allocated(u_op)) then + call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return + end if + idx = 1 + FieldMask = .false. + FieldMask(MASKID_TranslationDisp) = .true. + FieldMask(MASKID_Orientation) = .true. + FieldMask(MASKID_TranslationVel) = .true. + FieldMask(MASKID_RotationVel) = .true. + FieldMask(MASKID_TranslationAcc) = .true. + FieldMask(MASKID_RotationAcc) = .true. + ! fill in the u_op values from the input mesh + call PackMotionMesh(u%CoupledKinematics(1), u_op, idx, FieldMask=FieldMask) + + ! now do the active tensioning commands if there are any + if (allocated(u%DeltaL)) then + do i=1,size(u%DeltaL) + u_op(idx) = u%DeltaL(i) + idx = idx + 1 + u_op(idx) = u%DeltaLdot(i) + idx = idx + 1 + end do + endif + END IF + ! outputs + IF ( PRESENT( y_op ) ) THEN + ny = p%Jac_ny + y%CoupledLoads(1)%NNodes * 6 ! Jac_ny has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + if (.not. allocated(y_op)) then + call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return + end if + idx = 1 + call PackLoadMesh(y%CoupledLoads(1), y_op, idx) + do i=1,p%NumOuts + y_op(idx) = y%WriteOutput(i) + idx = idx + 1 + end do + END IF + ! states + IF ( PRESENT( x_op ) ) THEN + if (.not. allocated(x_op)) then + call AllocAry(x_op, p%Jac_nx,'x_op',ErrStat2,ErrMsg2); if (Failed()) return + end if + do i=1, p%Jac_nx + x_op(i) = x%states(p%dxIdx_map2_xStateIdx(i)) ! x for lin is different order, so use mapping + end do + END IF + ! state derivatives? + IF ( PRESENT( dx_op ) ) THEN + if (.not. allocated(dx_op)) then + call AllocAry(dx_op, p%Jac_nx,'dx_op',ErrStat2,ErrMsg2); if(failed()) return + end if + call MD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) ; if(Failed()) return + do i=1, p%Jac_nx + dx_op(i) = dx%states(p%dxIdx_map2_xStateIdx(i)) ! x for lin is different order, so use mapping + end do + END IF + IF ( PRESENT( xd_op ) ) THEN + ! pass + END IF + IF ( PRESENT( z_op ) ) THEN + ! pass + END IF + call CleanUp() +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_GetOP') + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + + subroutine CleanUp() + call MD_DestroyContState(dx, ErrStat2, ErrMsg2); + end subroutine +END SUBROUTINE MD_GetOP + + + +!==================================================================================================== +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!> 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 subroutines calculating dXdx etc (MD_Compute_dX) +SUBROUTINE MD_Init_Jacobian(Init, p, u, y, m, InitOut, ErrStat, ErrMsg) + TYPE(MD_InitInputType) , INTENT(IN ) :: Init !< Init + TYPE(MD_ParameterType) , INTENT(INOUT) :: p !< parameters + TYPE(MD_InputType) , INTENT(IN ) :: u !< inputs + TYPE(MD_OutputType) , INTENT(IN ) :: y !< outputs + TYPE(MD_MiscVarType) , INTENT(INOUT) :: m !< misc variables <<<<<<<< + TYPE(MD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) + INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Init_Jacobian' + real(ReKi) :: dx, dy, dz, maxDim + + INTEGER(IntKi) :: l, I + real(ReKi) :: dl_slack ! how much a given line segment is stretched [m] + real(ReKi) :: dl_slack_min ! minimum change in a node position for the least-strained segment in the simulation to go slack [m] + + + ! local variables: + ErrStat = ErrID_None + ErrMsg = "" + + !! --- System dimension + !dx = maxval(Init%Nodes(:,2))- minval(Init%Nodes(:,2)) + !dy = maxval(Init%Nodes(:,3))- minval(Init%Nodes(:,3)) + !dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) + !maxDim = max(dx, dy, dz) + + + ! Figure out appropriate transverse perturbation size to avoid slack segments + dl_slack_min = 0.1_ReKi ! start at 0.1 m + + do l = 1,p%nLines + do I = 1, m%LineList(l)%N + dl_slack = m%LineList(l)%lstr(I) - m%LineList(l)%l(I) + + ! store the smallest positive length margin to a segment going slack + if (( dl_slack > 0.0_ReKi) .and. (dl_slack < dl_slack_min)) then + dl_slack_min = dl_slack + end if + end do + end do + + dl_slack_min = 0.5*dl_slack_min ! apply 0.5 safety factor + + !TODO: consider attachment radii to also produce a rotational perturbation size from the above + + + ! --- System dimension + call Init_Jacobian_y(); if (Failed()) return + call Init_Jacobian_x(); if (Failed()) return + call Init_Jacobian_u(); if (Failed()) return + +contains + LOGICAL FUNCTION Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_Init_Jacobian') + Failed = ErrStat >= AbortErrLev + END FUNCTION Failed + + !> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. + SUBROUTINE Init_Jacobian_y() + INTEGER(IntKi) :: index_next, i + + ! Number of outputs + p%Jac_ny = y%CoupledLoads(1)%nNodes * 6 & ! 3 forces + 3 moments at each node (moments may be zero) + + p%NumOuts ! WriteOutput values + ! Storage info for each output (names, rotframe) + call AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return + call AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return + ! Names + index_next = 1 + call PackLoadMesh_Names( y%CoupledLoads(1), 'LinNames_y', InitOut%LinNames_y, index_next) ! <<< should a specific name be provided here? + do i=1,p%NumOuts + InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) + end do + + InitOut%RotFrame_y(:) = .false. + END SUBROUTINE Init_Jacobian_y + !> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. + SUBROUTINE Init_Jacobian_x() + INTEGER(IntKi) :: idx ! index into the LinNames_x array + INTEGER(IntKi) :: i + INTEGER(IntKi) :: l + INTEGER(IntKi) :: N + + p%Jac_nx = m%Nx ! size of (continuous) state vector (includes the first derivatives) + + ! allocate space for the row/column names and for perturbation sizes + CALL AllocAry(InitOut%LinNames_x , p%Jac_nx, 'LinNames_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return + CALL AllocAry(InitOut%RotFrame_x , p%Jac_nx, 'RotFrame_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return + CALL AllocAry(InitOut%DerivOrder_x , p%Jac_nx, 'DerivOrder_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return + CALL AllocAry(p%dx , p%Jac_nx, 'p%dx' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return + CALL AllocAry(p%dxIdx_map2_xStateIdx, p%Jac_nx, 'p%dxIdx_map2_xStateIdx', ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return + + p%dxIdx_map2_xStateIdx = 0_IntKi ! all values should be overwritten by logic below + + ! set linearization output names and default perturbations, p%dx: + ! NOTE: the order is different than the order of the internal states. This is to + ! match what the OpenFAST framework is expecting: all positions first, then all + ! derviatives of positions (velocity terms) second. This adds slight complexity + ! here, but considerably simplifies post processing of the full OpenFAST results + ! for linearization. + ! The p%dxIdx_map2_xStateIdx array holds the index for the x%states array + ! corresponding to the current jacobian index. + + !----------------- + ! position states + !----------------- + 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 + END DO - CALL CleanUp() ! deallocate temporary arrays + ! Rods + DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) + if (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' + InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_y, rad' + InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_z, rad' + p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+3 ! x%state index for rot_x + p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+4 ! x%state index for rot_y + p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+5 ! x%state index for rot_z + idx = idx + 3 + else ! free rod + p%dx(idx+1:idx+3) = dl_slack_min ! rod displacement [m] + p%dx(idx+4:idx+6) = 0.02 ! rod rotation [rad] + ! corresponds to state indices: (m%RodStateIs1(l)+6:m%RodStateIs1(l)+11) + InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Px, m' + InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Py, m' + InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Pz, m' + InitOut%LinNames_x(idx+4) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_x, rad' + InitOut%LinNames_x(idx+5) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_y, rad' + InitOut%LinNames_x(idx+6) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_z, rad' + p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+6 ! x%state index for Px + p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+7 ! x%state index for Py + p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+8 ! x%state index for Pz + p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+9 ! x%state index for rot_x + p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+10 ! x%state index for rot_y + p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+11 ! x%state index for rot_z + idx = idx + 6 + end if + END DO + ! Free Connnections + DO l = 1,p%nFreeCons ! Point m%ConnectList(m%FreeConIs(l)) + ! corresponds to state indices: (m%ConStateIs1(l)+3:m%ConStateIs1(l)+5) + p%dx(idx+1:idx+3) = dl_slack_min ! point displacement [m] + InitOut%LinNames_x(idx+1) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Px, m' + InitOut%LinNames_x(idx+2) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Py, m' + InitOut%LinNames_x(idx+3) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Pz, m' + p%dxIdx_map2_xStateIdx(idx+1) = m%ConStateIs1(l)+3 ! x%state index for Px + p%dxIdx_map2_xStateIdx(idx+2) = m%ConStateIs1(l)+4 ! x%state index for Py + p%dxIdx_map2_xStateIdx(idx+3) = m%ConStateIs1(l)+5 ! x%state index for Pz + idx = idx + 3 + END DO + ! Lines + DO l = 1,p%nLines ! Line m%LineList(l) + ! corresponds to state indices: (m%LineStateIs1(l)+3*N-3:m%LineStateIs1(l)+6*N-7) -- NOTE: end nodes not included + N = m%LineList(l)%N ! number of segments in the line + DO i = 0,N-2 + p%dx(idx+1:idx+3) = dl_slack_min ! line internal node displacement [m] + InitOut%LinNames_x(idx+1) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Px, m' + InitOut%LinNames_x(idx+2) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Py, m' + InitOut%LinNames_x(idx+3) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Pz, m' + p%dxIdx_map2_xStateIdx(idx+1) = m%LineStateIs1(l)+3*N+3*i-3 ! x%state index for Px + p%dxIdx_map2_xStateIdx(idx+2) = m%LineStateIs1(l)+3*N+3*i-2 ! x%state index for Py + p%dxIdx_map2_xStateIdx(idx+3) = m%LineStateIs1(l)+3*N+3*i-1 ! x%state index for Pz + idx = idx + 3 + END DO + END DO - CONTAINS + !----------------- + ! velocity states + !----------------- + ! 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 + 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 + ! 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' + InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_y, rad/s' + InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_z, rad/s' + p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+0 ! x%state index for Vx + p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+1 ! x%state index for Vy + p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+2 ! x%state index for Vz + idx = idx + 3 + else ! free rod + ! corresponds to state indices: (m%RodStateIs1(l):m%RodStateIs1(l)+5) + p%dx(idx+1:idx+3) = 0.1 ! body translational velocity [m/s] + p%dx(idx+4:idx+6) = 0.02 ! body rotational velocity [rad/s] + InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vx, m/s' + InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vy, m/s' + InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vz, m/s' + InitOut%LinNames_x(idx+4) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_x, rad/s' + InitOut%LinNames_x(idx+5) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_y, rad/s' + InitOut%LinNames_x(idx+6) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_z, rad/s' + p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+0 ! x%state index for Vx + p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+1 ! x%state index for Vy + p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+2 ! x%state index for Vz + p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+3 ! x%state index for omega_x + p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+4 ! x%state index for omega_y + p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+5 ! x%state index for omega_z + idx = idx + 6 + end if + END DO - !======================================================================= - SUBROUTINE CleanUp() - ! deallocate temporary arrays - - IF (ALLOCATED(LSNodes)) DEALLOCATE(LSNodes) - IF (ALLOCATED(LNodesX)) DEALLOCATE(LNodesX) - IF (ALLOCATED(LNodesZ)) DEALLOCATE(LNodesZ) - - END SUBROUTINE CleanUp - !======================================================================= - - - !======================================================================= - SUBROUTINE Catenary ( XF_In, ZF_In, L_In , EA_In, & - W_In , CB_In, Tol_In, N , & - s_In , X_In , Z_In , ErrStat, ErrMsg ) - - ! This subroutine is copied from FAST v7 with minor modifications - - ! This routine solves the analytical, static equilibrium equations - ! for a catenary (or taut) mooring line with seabed interaction. - ! Stretching of the line is accounted for, but bending stiffness - ! is not. Given the mooring line properties and the fairlead - ! position relative to the anchor, this routine finds the line - ! configuration and tensions. Since the analytical solution - ! involves two nonlinear equations (XF and ZF) in two unknowns - ! (HF and VF), a Newton-Raphson iteration scheme is implemented in - ! order to solve for the solution. The values of HF and VF that - ! are passed into this routine are used as the initial guess in - ! the iteration. The Newton-Raphson iteration is only accurate in - ! double precision, so all of the input/output arguments are - ! converteds to/from double precision from/to default precision. - - - ! USE Precision - - - IMPLICIT NONE - - - ! Passed Variables: - - INTEGER(4), INTENT(IN ) :: N ! Number of nodes where the line position and tension can be output (-) - - REAL(DbKi), INTENT(IN ) :: CB_In ! Coefficient of seabed static friction drag (a negative value indicates no seabed) (-) - REAL(DbKi), INTENT(IN ) :: EA_In ! Extensional stiffness of line (N) - ! REAL(DbKi), INTENT( OUT) :: HA_In ! Effective horizontal tension in line at the anchor (N) - ! REAL(DbKi), INTENT(INOUT) :: HF_In ! Effective horizontal tension in line at the fairlead (N) - REAL(DbKi), INTENT(IN ) :: L_In ! Unstretched length of line (meters) - REAL(DbKi), INTENT(IN ) :: s_In (N) ! Unstretched arc distance along line from anchor to each node where the line position and tension can be output (meters) - ! REAL(DbKi), INTENT( OUT) :: Te_In (N) ! Effective line tensions at each node (N) - REAL(DbKi), INTENT(IN ) :: Tol_In ! Convergence tolerance within Newton-Raphson iteration specified as a fraction of tension (-) - ! REAL(DbKi), INTENT( OUT) :: VA_In ! Effective vertical tension in line at the anchor (N) - ! REAL(DbKi), INTENT(INOUT) :: VF_In ! Effective vertical tension in line at the fairlead (N) - REAL(DbKi), INTENT(IN ) :: W_In ! Weight of line in fluid per unit length (N/m) - REAL(DbKi), INTENT( OUT) :: X_In (N) ! Horizontal locations of each line node relative to the anchor (meters) - REAL(DbKi), INTENT(IN ) :: XF_In ! Horizontal distance between anchor and fairlead (meters) - REAL(DbKi), INTENT( OUT) :: Z_In (N) ! Vertical locations of each line node relative to the anchor (meters) - REAL(DbKi), INTENT(IN ) :: ZF_In ! Vertical distance between anchor and fairlead (meters) - 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(DbKi) :: CB ! Coefficient of seabed static friction (a negative value indicates no seabed) (-) - REAL(DbKi) :: CBOvrEA ! = CB/EA - REAL(DbKi) :: DET ! Determinant of the Jacobian matrix (m^2/N^2) - REAL(DbKi) :: dHF ! Increment in HF predicted by Newton-Raphson (N) - REAL(DbKi) :: dVF ! Increment in VF predicted by Newton-Raphson (N) - REAL(DbKi) :: dXFdHF ! Partial derivative of the calculated horizontal distance with respect to the horizontal fairlead tension (m/N): dXF(HF,VF)/dHF - REAL(DbKi) :: dXFdVF ! Partial derivative of the calculated horizontal distance with respect to the vertical fairlead tension (m/N): dXF(HF,VF)/dVF - REAL(DbKi) :: dZFdHF ! Partial derivative of the calculated vertical distance with respect to the horizontal fairlead tension (m/N): dZF(HF,VF)/dHF - REAL(DbKi) :: dZFdVF ! Partial derivative of the calculated vertical distance with respect to the vertical fairlead tension (m/N): dZF(HF,VF)/dVF - REAL(DbKi) :: EA ! Extensional stiffness of line (N) - REAL(DbKi) :: EXF ! Error function between calculated and known horizontal distance (meters): XF(HF,VF) - XF - REAL(DbKi) :: EZF ! Error function between calculated and known vertical distance (meters): ZF(HF,VF) - ZF - REAL(DbKi) :: HA ! Effective horizontal tension in line at the anchor (N) - REAL(DbKi) :: HF ! Effective horizontal tension in line at the fairlead (N) - REAL(DbKi) :: HFOvrW ! = HF/W - REAL(DbKi) :: HFOvrWEA ! = HF/WEA - REAL(DbKi) :: L ! Unstretched length of line (meters) - REAL(DbKi) :: Lamda0 ! Catenary parameter used to generate the initial guesses of the horizontal and vertical tensions at the fairlead for the Newton-Raphson iteration (-) - REAL(DbKi) :: LMax ! Maximum stretched length of the line with seabed interaction beyond which the line would have to double-back on itself; here the line forms an "L" between the anchor and fairlead (i.e. it is horizontal along the seabed from the anchor, then vertical to the fairlead) (meters) - REAL(DbKi) :: LMinVFOvrW ! = L - VF/W - REAL(DbKi) :: LOvrEA ! = L/EA - REAL(DbKi) :: s (N) ! Unstretched arc distance along line from anchor to each node where the line position and tension can be output (meters) - REAL(DbKi) :: sOvrEA ! = s(I)/EA - REAL(DbKi) :: SQRT1VFOvrHF2 ! = SQRT( 1.0_DbKi + VFOvrHF2 ) - REAL(DbKi) :: SQRT1VFMinWLOvrHF2 ! = SQRT( 1.0_DbKi + VFMinWLOvrHF2 ) - REAL(DbKi) :: SQRT1VFMinWLsOvrHF2 ! = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) - REAL(DbKi) :: Te (N) ! Effective line tensions at each node (N) - REAL(DbKi) :: Tol ! Convergence tolerance within Newton-Raphson iteration specified as a fraction of tension (-) - REAL(DbKi) :: VA ! Effective vertical tension in line at the anchor (N) - REAL(DbKi) :: VF ! Effective vertical tension in line at the fairlead (N) - REAL(DbKi) :: VFMinWL ! = VF - WL - REAL(DbKi) :: VFMinWLOvrHF ! = VFMinWL/HF - REAL(DbKi) :: VFMinWLOvrHF2 ! = VFMinWLOvrHF*VFMinWLOvrHF - REAL(DbKi) :: VFMinWLs ! = VFMinWL + Ws - REAL(DbKi) :: VFMinWLsOvrHF ! = VFMinWLs/HF - REAL(DbKi) :: VFOvrHF ! = VF/HF - REAL(DbKi) :: VFOvrHF2 ! = VFOvrHF*VFOvrHF - REAL(DbKi) :: VFOvrWEA ! = VF/WEA - REAL(DbKi) :: W ! Weight of line in fluid per unit length (N/m) - REAL(DbKi) :: WEA ! = W*EA - REAL(DbKi) :: WL ! Total weight of line in fluid (N): W*L - REAL(DbKi) :: Ws ! = W*s(I) - REAL(DbKi) :: X (N) ! Horizontal locations of each line node relative to the anchor (meters) - REAL(DbKi) :: XF ! Horizontal distance between anchor and fairlead (meters) - REAL(DbKi) :: XF2 ! = XF*XF - REAL(DbKi) :: Z (N) ! Vertical locations of each line node relative to the anchor (meters) - REAL(DbKi) :: ZF ! Vertical distance between anchor and fairlead (meters) - REAL(DbKi) :: ZF2 ! = ZF*ZF - - INTEGER(4) :: I ! Index for counting iterations or looping through line nodes (-) - INTEGER(4) :: MaxIter ! Maximum number of Newton-Raphson iterations possible before giving up (-) - - LOGICAL :: FirstIter ! Flag to determine whether or not this is the first time through the Newton-Raphson interation (flag) - - - ErrStat = ERrId_None - - - ! The Newton-Raphson iteration is only accurate in double precision, so - ! convert the input arguments into double precision: - - CB = REAL( CB_In , DbKi ) - EA = REAL( EA_In , DbKi ) - HF = 0.0_DbKi ! = REAL( HF_In , DbKi ) - L = REAL( L_In , DbKi ) - s (:) = REAL( s_In (:), DbKi ) - Tol = REAL( Tol_In , DbKi ) - VF = 0.0_DbKi ! keeping this for some error catching functionality? (at first glance) ! VF = REAL( VF_In , DbKi ) - W = REAL( W_In , DbKi ) - XF = REAL( XF_In , DbKi ) - ZF = REAL( ZF_In , DbKi ) + ! Free Connnections + DO l = 1,p%nFreeCons ! Point m%ConnectList(m%FreeConIs(l)) + ! corresponds to state indices: (m%ConStateIs1(l):m%ConStateIs1(l)+2) + p%dx(idx+1:idx+3) = 0.1 ! point translational velocity [m/s] + InitOut%LinNames_x(idx+1) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Vx, m/s' + InitOut%LinNames_x(idx+2) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Vy, m/s' + InitOut%LinNames_x(idx+3) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Vz, m/s' + p%dxIdx_map2_xStateIdx(idx+1) = m%ConStateIs1(l)+0 ! x%state index for Vx + p%dxIdx_map2_xStateIdx(idx+2) = m%ConStateIs1(l)+1 ! x%state index for Vy + p%dxIdx_map2_xStateIdx(idx+3) = m%ConStateIs1(l)+2 ! x%state index for Vz + idx = idx + 3 + END DO + ! Lines + DO l = 1,p%nLines ! Line m%LineList(l) + ! corresponds to state indices: (m%LineStateIs1(l):m%LineStateIs1(l)+3*N-4) -- NOTE: end nodes not included + N = m%LineList(l)%N ! number of segments in the line + DO i = 0,N-2 + p%dx(idx+1:idx+3) = 0.1 ! line internal node translational velocity [m/s] + InitOut%LinNames_x(idx+1) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vx, m/s' + InitOut%LinNames_x(idx+2) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vy, m/s' + InitOut%LinNames_x(idx+3) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vz, m/s' + p%dxIdx_map2_xStateIdx(idx+1) = m%LineStateIs1(l)+3*i+0 ! x%state index for Vx + p%dxIdx_map2_xStateIdx(idx+2) = m%LineStateIs1(l)+3*i+1 ! x%state index for Vy + p%dxIdx_map2_xStateIdx(idx+3) = m%LineStateIs1(l)+3*i+2 ! x%state index for Vz + idx = idx + 3 + END DO + END DO + ! If a summary file is ever made... + ! !Formatting may be needed to make it pretty + ! if(UnSum > 0) then + ! write(UnSum,*) ' Lin_Jac_x idx x%state idx' + ! do i=1,p%Jac_nx + ! write(UnSum,*) InitOut%LinNames_x(i),' ',i,' ',p%dxIdx_map2_xStateIdx(i) + ! enddo + ! endif + + InitOut%RotFrame_x = .false. + InitOut%DerivOrder_x = 2 + END SUBROUTINE Init_Jacobian_x + + SUBROUTINE Init_Jacobian_u() + INTEGER(IntKi) :: i, j, idx, nu, i_meshField + character(10) :: LinStr ! for noting which line a DeltaL control is attached to + logical :: LinCtrl ! Is the current DeltaL channel associated with a line? + ! Number of inputs + i = 0 + if (allocated(u%DeltaL)) i=size(u%DeltaL) + nu = u%CoupledKinematics(1)%nNodes * 18 & ! 3 Translation Displacements + 3 orientations + 6 velocities + 6 accelerations at each node <<<<<<< + + i*2 ! a deltaL and rate of change for each active tension control channel + + ! --- Info of linearized inputs (Names, RotFrame, IsLoad) + call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return + call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return + call AllocAry(InitOut%IsLoad_u , nu, 'IsLoad_u' , ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return + + InitOut%IsLoad_u = .false. ! None of MoorDyn's inputs are loads + InitOut%RotFrame_u = .false. ! every input is on a mesh, which stores values in the global (not rotating) frame + + idx = 1 + call PackMotionMesh_Names(u%CoupledKinematics(1), 'CoupledKinematics', InitOut%LinNames_u, idx) ! all 6 motion fields + + ! --- Jac_u_indx: matrix to store index to help us figure out what the ith value of the u vector really means + ! (see perturb_u ... these MUST match ) + ! column 1 indicates module's mesh and field + ! column 2 indicates the first index (x-y-z component) of the field + ! column 3 is the node + call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return + p%Jac_u_indx = 0 ! initialize to zero + idx = 1 + !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationDisp = 1; + !Module/Mesh/Field: u%CoupledKinematics(1)%Orientation = 2; + !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationVel = 3; + !Module/Mesh/Field: u%CoupledKinematics(1)%RotationVel = 4; + !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationAcc = 5; + !Module/Mesh/Field: u%CoupledKinematics(1)%RotationAcc = 6; + do i_meshField = 1,6 + do i=1,u%CoupledKinematics(1)%nNodes + do j=1,3 + p%Jac_u_indx(idx,1) = i_meshField ! mesh field type (indicated by 1-6) + p%Jac_u_indx(idx,2) = j ! x, y, or z + p%Jac_u_indx(idx,3) = i ! node + idx = idx + 1 + end do !j + end do !i + end do + ! now do the active tensioning commands if there are any + if (allocated(u%DeltaL)) then + do i=1,size(u%DeltaL) ! Signals may be passed in without being requested for control + ! Figure out if this DeltaL control channel is associated with a line or multiple or none and label + LinCtrl = .FALSE. + LinStr = '(lines: ' + do J=1,p%NLines + if (m%LineList(J)%CtrlChan == i) then + LinCtrl = .TRUE. + LinStr = LinStr//trim(num2lstr(i))//' ' + endif + enddo + if ( LinCtrl) LinStr = LinStr//' )' + if (.not. LinCtrl) LinStr = '(lines: none)' + + p%Jac_u_indx(idx,1) = 10 ! 10-11 mean active tension changes (10: deltaL; 11: deltaLdot) + p%Jac_u_indx(idx,2) = 0 ! not used + p%Jac_u_indx(idx,3) = i ! indicates DeltaL entry number + InitOut%LinNames_u(idx) = 'CtrlChan DeltaL '//trim(num2lstr(i))//', m '//trim(LinStr) + idx = idx + 1 - ! HF and VF cannot be initialized to zero when a portion of the line rests on the seabed and the anchor tension is nonzero - - ! Generate the initial guess values for the horizontal and vertical tensions - ! at the fairlead in the Newton-Raphson iteration for the catenary mooring - ! line solution. Use starting values documented in: Peyrot, Alain H. and - ! Goulois, A. M., "Analysis Of Cable Structures," Computers & Structures, - ! Vol. 10, 1979, pp. 805-813: - XF2 = XF*XF - ZF2 = ZF*ZF - - IF ( XF == 0.0_DbKi ) THEN ! .TRUE. if the current mooring line is exactly vertical - Lamda0 = 1.0D+06 - ELSEIF ( L <= SQRT( XF2 + ZF2 ) ) THEN ! .TRUE. if the current mooring line is taut - Lamda0 = 0.2_DbKi - ELSE ! The current mooring line must be slack and not vertical - Lamda0 = SQRT( 3.0_DbKi*( ( L**2 - ZF2 )/XF2 - 1.0_DbKi ) ) - ENDIF - - HF = ABS( 0.5_DbKi*W* XF/ Lamda0 ) - VF = 0.5_DbKi*W*( ZF/TANH(Lamda0) + L ) - - - ! Abort when there is no solution or when the only possible solution is - ! illogical: - - IF ( Tol <= EPSILON(TOL) ) THEN ! .TRUE. when the convergence tolerance is specified incorrectly - ErrStat = ErrID_Warn - ErrMsg = ' Convergence tolerance must be greater than zero in routine Catenary().' - return - ELSEIF ( XF < 0.0_DbKi ) THEN ! .TRUE. only when the local coordinate system is not computed correctly - ErrStat = ErrID_Warn - ErrMsg = ' The horizontal distance between an anchor and its'// & - ' fairlead must not be less than zero in routine Catenary().' - return - - ELSEIF ( ZF < 0.0_DbKi ) THEN ! .TRUE. if the fairlead has passed below its anchor - ErrStat = ErrID_Warn - ErrMsg = ' A fairlead has passed below its anchor.' - return - - ELSEIF ( L <= 0.0_DbKi ) THEN ! .TRUE. when the unstretched line length is specified incorrectly - ErrStat = ErrID_Warn - ErrMsg = ' Unstretched length of line must be greater than zero in routine Catenary().' - return - - ELSEIF ( EA <= 0.0_DbKi ) THEN ! .TRUE. when the unstretched line length is specified incorrectly - ErrStat = ErrID_Warn - ErrMsg = ' Extensional stiffness of line must be greater than zero in routine Catenary().' - return - - ELSEIF ( W == 0.0_DbKi ) THEN ! .TRUE. when the weight of the line in fluid is zero so that catenary solution is ill-conditioned - ErrStat = ErrID_Warn - ErrMsg = ' The weight of the line in fluid must not be zero. '// & - ' Routine Catenary() cannot solve quasi-static mooring line solution.' - return - - - ELSEIF ( W > 0.0_DbKi ) THEN ! .TRUE. when the line will sink in fluid - - LMax = XF - EA/W + SQRT( (EA/W)*(EA/W) + 2.0_DbKi*ZF*EA/W ) ! Compute the maximum stretched length of the line with seabed interaction beyond which the line would have to double-back on itself; here the line forms an "L" between the anchor and fairlead (i.e. it is horizontal along the seabed from the anchor, then vertical to the fairlead) - - IF ( ( L >= LMax ) .AND. ( CB >= 0.0_DbKi ) ) then ! .TRUE. if the line is as long or longer than its maximum possible value with seabed interaction - ErrStat = ErrID_Warn - ErrMsg = ' Unstretched mooring line length too large. '// & - ' Routine Catenary() cannot solve quasi-static mooring line solution.' - return - END IF - - ENDIF - - - ! Initialize some commonly used terms that don't depend on the iteration: - - WL = W *L - WEA = W *EA - LOvrEA = L /EA - CBOvrEA = CB /EA - MaxIter = INT(1.0_DbKi/Tol) ! Smaller tolerances may take more iterations, so choose a maximum inversely proportional to the tolerance - - - - ! To avoid an ill-conditioned situation, ensure that the initial guess for - ! HF is not less than or equal to zero. Similarly, avoid the problems - ! associated with having exactly vertical (so that HF is zero) or exactly - ! horizontal (so that VF is zero) lines by setting the minimum values - ! equal to the tolerance. This prevents us from needing to implement - ! the known limiting solutions for vertical or horizontal lines (and thus - ! complicating this routine): - - HF = MAX( HF, Tol ) - XF = MAX( XF, Tol ) - ZF = MAX( ZF, TOl ) - - - - ! Solve the analytical, static equilibrium equations for a catenary (or - ! taut) mooring line with seabed interaction: - - ! Begin Newton-Raphson iteration: - - I = 1 ! Initialize iteration counter - FirstIter = .TRUE. ! Initialize iteration flag - - DO - - - ! Initialize some commonly used terms that depend on HF and VF: - - VFMinWL = VF - WL - LMinVFOvrW = L - VF/W - HFOvrW = HF/W - HFOvrWEA = HF/WEA - VFOvrWEA = VF/WEA - VFOvrHF = VF/HF - VFMinWLOvrHF = VFMinWL/HF - VFOvrHF2 = VFOvrHF *VFOvrHF - VFMinWLOvrHF2 = VFMinWLOvrHF*VFMinWLOvrHF - SQRT1VFOvrHF2 = SQRT( 1.0_DbKi + VFOvrHF2 ) - SQRT1VFMinWLOvrHF2 = SQRT( 1.0_DbKi + VFMinWLOvrHF2 ) - - - ! Compute the error functions (to be zeroed) and the Jacobian matrix - ! (these depend on the anticipated configuration of the mooring line): - - IF ( ( CB < 0.0_DbKi ) .OR. ( W < 0.0_DbKi ) .OR. ( VFMinWL > 0.0_DbKi ) ) THEN ! .TRUE. when no portion of the line rests on the seabed - - EXF = ( LOG( VFOvrHF + SQRT1VFOvrHF2 ) & - - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )*HFOvrW & - + LOvrEA* HF - XF - EZF = ( SQRT1VFOvrHF2 & - - SQRT1VFMinWLOvrHF2 )*HFOvrW & - + LOvrEA*( VF - 0.5_DbKi*WL ) - ZF - - dXFdHF = ( LOG( VFOvrHF + SQRT1VFOvrHF2 ) & - - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W & - - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) & - - ( VFMinWLOvrHF + VFMinWLOvrHF2/SQRT1VFMinWLOvrHF2 )/( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W & - + LOvrEA - dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) & - - ( 1.0_DbKi + VFMinWLOvrHF /SQRT1VFMinWLOvrHF2 )/( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W - dZFdHF = ( SQRT1VFOvrHF2 & - - SQRT1VFMinWLOvrHF2 )/ W & - - ( VFOvrHF2 /SQRT1VFOvrHF2 & - - VFMinWLOvrHF2/SQRT1VFMinWLOvrHF2 )/ W - dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 & - - VFMinWLOvrHF /SQRT1VFMinWLOvrHF2 )/ W & - + LOvrEA - - - ELSEIF ( -CB*VFMinWL < HF ) THEN ! .TRUE. when a portion of the line rests on the seabed and the anchor tension is nonzero - - EXF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) *HFOvrW & - - 0.5_DbKi*CBOvrEA*W* LMinVFOvrW*LMinVFOvrW & - + LOvrEA* HF + LMinVFOvrW - XF - EZF = ( SQRT1VFOvrHF2 - 1.0_DbKi )*HFOvrW & - + 0.5_DbKi*VF*VFOvrWEA - ZF - - dXFdHF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) / W & - - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & - + LOvrEA - dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & - + CBOvrEA*LMinVFOvrW - 1.0_DbKi/W - dZFdHF = ( SQRT1VFOvrHF2 - 1.0_DbKi & - - VFOvrHF2 /SQRT1VFOvrHF2 )/ W - dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 )/ W & - + VFOvrWEA - - - ELSE ! 0.0_DbKi < HF <= -CB*VFMinWL ! A portion of the line must rest on the seabed and the anchor tension is zero - - EXF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) *HFOvrW & - - 0.5_DbKi*CBOvrEA*W*( LMinVFOvrW*LMinVFOvrW - ( LMinVFOvrW - HFOvrW/CB )*( LMinVFOvrW - HFOvrW/CB ) ) & - + LOvrEA* HF + LMinVFOvrW - XF - EZF = ( SQRT1VFOvrHF2 - 1.0_DbKi )*HFOvrW & - + 0.5_DbKi*VF*VFOvrWEA - ZF - - dXFdHF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) / W & - - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & - + LOvrEA - ( LMinVFOvrW - HFOvrW/CB )/EA - dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & - + HFOvrWEA - 1.0_DbKi/W - dZFdHF = ( SQRT1VFOvrHF2 - 1.0_DbKi & - - VFOvrHF2 /SQRT1VFOvrHF2 )/ W - dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 )/ W & - + VFOvrWEA - - - ENDIF - - - ! Compute the determinant of the Jacobian matrix and the incremental - ! tensions predicted by Newton-Raphson: - - - DET = dXFdHF*dZFdVF - dXFdVF*dZFdHF - - if ( EqualRealNos( DET, 0.0_DbKi ) ) then -!bjj: there is a serious problem with the debugger here when DET = 0 - ErrStat = ErrID_Warn - ErrMsg = ' Iteration not convergent (DET is 0). '// & - ' Routine Catenary() cannot solve quasi-static mooring line solution.' - return - endif - - - dHF = ( -dZFdVF*EXF + dXFdVF*EZF )/DET ! This is the incremental change in horizontal tension at the fairlead as predicted by Newton-Raphson - dVF = ( dZFdHF*EXF - dXFdHF*EZF )/DET ! This is the incremental change in vertical tension at the fairlead as predicted by Newton-Raphson - - dHF = dHF*( 1.0_DbKi - Tol*I ) ! Reduce dHF by factor (between 1 at I = 1 and 0 at I = MaxIter) that reduces linearly with iteration count to ensure that we converge on a solution even in the case were we obtain a nonconvergent cycle about the correct solution (this happens, for example, if we jump to quickly between a taut and slack catenary) - dVF = dVF*( 1.0_DbKi - Tol*I ) ! Reduce dHF by factor (between 1 at I = 1 and 0 at I = MaxIter) that reduces linearly with iteration count to ensure that we converge on a solution even in the case were we obtain a nonconvergent cycle about the correct solution (this happens, for example, if we jump to quickly between a taut and slack catenary) - - dHF = MAX( dHF, ( Tol - 1.0_DbKi )*HF ) ! To avoid an ill-conditioned situation, make sure HF does not go less than or equal to zero by having a lower limit of Tol*HF [NOTE: the value of dHF = ( Tol - 1.0_DbKi )*HF comes from: HF = HF + dHF = Tol*HF when dHF = ( Tol - 1.0_DbKi )*HF] - - ! Check if we have converged on a solution, or restart the iteration, or - ! Abort if we cannot find a solution: - - IF ( ( ABS(dHF) <= ABS(Tol*HF) ) .AND. ( ABS(dVF) <= ABS(Tol*VF) ) ) THEN ! .TRUE. if we have converged; stop iterating! [The converge tolerance, Tol, is a fraction of tension] - - EXIT - - - ELSEIF ( ( I == MaxIter ) .AND. ( FirstIter ) ) THEN ! .TRUE. if we've iterated MaxIter-times for the first time; - - ! Perhaps we failed to converge because our initial guess was too far off. - ! (This could happen, for example, while linearizing a model via large - ! pertubations in the DOFs.) Instead, use starting values documented in: - ! Peyrot, Alain H. and Goulois, A. M., "Analysis Of Cable Structures," - ! Computers & Structures, Vol. 10, 1979, pp. 805-813: - ! NOTE: We don't need to check if the current mooring line is exactly - ! vertical (i.e., we don't need to check if XF == 0.0), because XF is - ! limited by the tolerance above. - - XF2 = XF*XF - ZF2 = ZF*ZF - - IF ( L <= SQRT( XF2 + ZF2 ) ) THEN ! .TRUE. if the current mooring line is taut - Lamda0 = 0.2_DbKi - ELSE ! The current mooring line must be slack and not vertical - Lamda0 = SQRT( 3.0_DbKi*( ( L*L - ZF2 )/XF2 - 1.0_DbKi ) ) - ENDIF - - HF = MAX( ABS( 0.5_DbKi*W* XF/ Lamda0 ), Tol ) ! As above, set the lower limit of the guess value of HF to the tolerance - VF = 0.5_DbKi*W*( ZF/TANH(Lamda0) + L ) - - - ! Restart Newton-Raphson iteration: - - I = 0 - FirstIter = .FALSE. - dHF = 0.0_DbKi - dVF = 0.0_DbKi - - - ELSEIF ( ( I == MaxIter ) .AND. ( .NOT. FirstIter ) ) THEN ! .TRUE. if we've iterated as much as we can take without finding a solution; Abort - ErrStat = ErrID_Warn - ErrMsg = ' Iteration not convergent. '// & - ' Routine Catenary() cannot solve quasi-static mooring line solution.' - RETURN - - - ENDIF - - - ! Increment fairlead tensions and iteration counter so we can try again: - - HF = HF + dHF - VF = VF + dVF - - I = I + 1 - - - ENDDO - - - - ! We have found a solution for the tensions at the fairlead! - - ! Now compute the tensions at the anchor and the line position and tension - ! at each node (again, these depend on the configuration of the mooring - ! line): - - IF ( ( CB < 0.0_DbKi ) .OR. ( W < 0.0_DbKi ) .OR. ( VFMinWL > 0.0_DbKi ) ) THEN ! .TRUE. when no portion of the line rests on the seabed - - ! Anchor tensions: - - HA = HF - VA = VFMinWL - - - ! Line position and tension at each node: - - DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed - - IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN - ErrStat = ErrID_Warn - ErrMsg = ' All line nodes must be located between the anchor ' & - //'and fairlead (inclusive) in routine Catenary().' - RETURN - END IF - - Ws = W *s(I) ! Initialize - VFMinWLs = VFMinWL + Ws ! some commonly - VFMinWLsOvrHF = VFMinWLs/HF ! used terms - sOvrEA = s(I) /EA ! that depend - SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) - - X (I) = ( LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) & - - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )*HFOvrW & - + sOvrEA* HF - Z (I) = ( SQRT1VFMinWLsOvrHF2 & - - SQRT1VFMinWLOvrHF2 )*HFOvrW & - + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) - Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) - - ENDDO ! I - All nodes where the line position and tension are to be computed - - - ELSEIF ( -CB*VFMinWL < HF ) THEN ! .TRUE. when a portion of the line rests on the seabed and the anchor tension is nonzero - - ! Anchor tensions: - - HA = HF + CB*VFMinWL - VA = 0.0_DbKi - - - ! Line position and tension at each node: - - DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed - - IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN - ErrStat = ErrID_Warn - ErrMsg = ' All line nodes must be located between the anchor ' & - //'and fairlead (inclusive) in routine Catenary().' - RETURN - END IF - - Ws = W *s(I) ! Initialize - VFMinWLs = VFMinWL + Ws ! some commonly - VFMinWLsOvrHF = VFMinWLs/HF ! used terms - sOvrEA = s(I) /EA ! that depend - SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) - - IF ( s(I) <= LMinVFOvrW ) THEN ! .TRUE. if this node rests on the seabed and the tension is nonzero - - X (I) = s(I) & - + sOvrEA*( HF + CB*VFMinWL + 0.5_DbKi*Ws*CB ) - Z (I) = 0.0_DbKi - Te(I) = HF + CB*VFMinWLs - - ELSE ! LMinVFOvrW < s <= L ! This node must be above the seabed - - X (I) = LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) *HFOvrW & - + sOvrEA* HF + LMinVFOvrW - 0.5_DbKi*CB*VFMinWL*VFMinWL/WEA - Z (I) = ( - 1.0_DbKi + SQRT1VFMinWLsOvrHF2 )*HFOvrW & - + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) + 0.5_DbKi* VFMinWL*VFMinWL/WEA - Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) - - ENDIF - - ENDDO ! I - All nodes where the line position and tension are to be computed - - - ELSE ! 0.0_DbKi < HF <= -CB*VFMinWL ! A portion of the line must rest on the seabed and the anchor tension is zero - - ! Anchor tensions: - - HA = 0.0_DbKi - VA = 0.0_DbKi - - - ! Line position and tension at each node: - - DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed - - IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN - ErrStat = ErrID_Warn - ErrMsg = ' All line nodes must be located between the anchor ' & - //'and fairlead (inclusive) in routine Catenary().' - RETURN - END IF - - Ws = W *s(I) ! Initialize - VFMinWLs = VFMinWL + Ws ! some commonly - VFMinWLsOvrHF = VFMinWLs/HF ! used terms - sOvrEA = s(I) /EA ! that depend - SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) - - IF ( s(I) <= LMinVFOvrW - HFOvrW/CB ) THEN ! .TRUE. if this node rests on the seabed and the tension is zero - - X (I) = s(I) - Z (I) = 0.0_DbKi - Te(I) = 0.0_DbKi - - ELSEIF ( s(I) <= LMinVFOvrW ) THEN ! .TRUE. if this node rests on the seabed and the tension is nonzero - - X (I) = s(I) - ( LMinVFOvrW - 0.5_DbKi*HFOvrW/CB )*HF/EA & - + sOvrEA*( HF + CB*VFMinWL + 0.5_DbKi*Ws*CB ) + 0.5_DbKi*CB*VFMinWL*VFMinWL/WEA - Z (I) = 0.0_DbKi - Te(I) = HF + CB*VFMinWLs - - ELSE ! LMinVFOvrW < s <= L ! This node must be above the seabed - - X (I) = LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) *HFOvrW & - + sOvrEA* HF + LMinVFOvrW - ( LMinVFOvrW - 0.5_DbKi*HFOvrW/CB )*HF/EA - Z (I) = ( - 1.0_DbKi + SQRT1VFMinWLsOvrHF2 )*HFOvrW & - + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) + 0.5_DbKi* VFMinWL*VFMinWL/WEA - Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) - - ENDIF - - ENDDO ! I - All nodes where the line position and tension are to be computed - - - ENDIF - - - - ! The Newton-Raphson iteration is only accurate in double precision, so - ! convert the output arguments back into the default precision for real - ! numbers: - - !HA_In = REAL( HA , DbKi ) !mth: for this I only care about returning node positions - !HF_In = REAL( HF , DbKi ) - !Te_In(:) = REAL( Te(:), DbKi ) - !VA_In = REAL( VA , DbKi ) - !VF_In = REAL( VF , DbKi ) - X_In (:) = REAL( X (:), DbKi ) - Z_In (:) = REAL( Z (:), DbKi ) - - END SUBROUTINE Catenary - !======================================================================= - - - END SUBROUTINE InitializeLine - !====================================================================== - - - - ! ============ below are some math convenience functions =============== - ! should add error checking if I keep these, but hopefully there are existing NWTCLib functions to replace them - - - ! return unit vector (u) in direction from r1 to r2 - !======================================================================= - SUBROUTINE UnitVector( u, r1, r2 ) - REAL(DbKi), INTENT(OUT) :: u(:) - REAL(DbKi), INTENT(IN) :: r1(:) - REAL(DbKi), INTENT(IN) :: r2(:) - - REAL(DbKi) :: Length - - u = r2 - r1 - Length = TwoNorm(u) - - if ( .NOT. EqualRealNos(length, 0.0_DbKi ) ) THEN - u = u / Length - END IF - - END SUBROUTINE UnitVector - !======================================================================= - - - !compute the inverse of a 3-by-3 matrix m - !======================================================================= - SUBROUTINE Inverse3by3( Minv, M ) - Real(DbKi), INTENT(OUT) :: Minv(:,:) ! returned inverse matrix - Real(DbKi), INTENT(IN) :: M(:,:) ! inputted matrix - - Real(DbKi) :: det ! the determinant - Real(DbKi) :: invdet ! inverse of the determinant - - det = M(1, 1) * (M(2, 2) * M(3, 3) - M(3, 2) * M(2, 3)) - & - M(1, 2) * (M(2, 1) * M(3, 3) - M(2, 3) * M(3, 1)) + & - M(1, 3) * (M(2, 1) * M(3, 2) - M(2, 2) * M(3, 1)); - - invdet = 1.0 / det ! because multiplying is faster than dividing + p%Jac_u_indx(idx,1) = 11 + p%Jac_u_indx(idx,2) = 0 + p%Jac_u_indx(idx,3) = i + InitOut%LinNames_u(idx) = 'CtrlChan DeltaLdot '//trim(num2lstr(i))//', m/s'//trim(LinStr) + idx = idx + 1 + end do + endif - Minv(1, 1) = (M(2, 2) * M(3, 3) - M(3, 2) * M(2, 3)) * invdet - Minv(1, 2) = (M(1, 3) * M(3, 2) - M(1, 2) * M(3, 3)) * invdet - Minv(1, 3) = (M(1, 2) * M(2, 3) - M(1, 3) * M(2, 2)) * invdet - Minv(2, 1) = (M(2, 3) * M(3, 1) - M(2, 1) * M(3, 3)) * invdet - Minv(2, 2) = (M(1, 1) * M(3, 3) - M(1, 3) * M(3, 1)) * invdet - Minv(2, 3) = (M(2, 1) * M(1, 3) - M(1, 1) * M(2, 3)) * invdet - Minv(3, 1) = (M(2, 1) * M(3, 2) - M(3, 1) * M(2, 2)) * invdet - Minv(3, 2) = (M(3, 1) * M(1, 2) - M(1, 1) * M(3, 2)) * invdet - Minv(3, 3) = (M(1, 1) * M(2, 2) - M(2, 1) * M(1, 2)) * invdet + ! --- Default perturbations, p%du: + call allocAry( p%du, 11, 'p%du', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return + p%du( 1) = dl_slack_min ! u%CoupledKinematics(1)%TranslationDisp = 1; + p%du( 2) = 0.1_ReKi ! u%CoupledKinematics(1)%Orientation = 2; + p%du( 3) = 0.1_ReKi ! u%CoupledKinematics(1)%TranslationVel = 3; + p%du( 4) = 0.1_ReKi ! u%CoupledKinematics(1)%RotationVel = 4; + p%du( 5) = 0.1_ReKi ! u%CoupledKinematics(1)%TranslationAcc = 5; + p%du( 6) = 0.1_ReKi ! u%CoupledKinematics(1)%RotationAcc = 6; + p%du(10) = dl_slack_min ! deltaL [m] + p%du(11) = 0.2_ReKi ! deltaLdot [m/s] + END SUBROUTINE Init_Jacobian_u + +END SUBROUTINE MD_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 MD_init_jacobian is consistant with this routine! +SUBROUTINE MD_Perturb_u( p, n, perturb_sign, u, du ) + TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters + INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use + INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) + TYPE(MD_InputType) , INTENT(INOUT) :: u !< perturbed MD inputs + REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed + ! local variables + INTEGER :: fieldIndx + INTEGER :: node + fieldIndx = p%Jac_u_indx(n,2) + node = p%Jac_u_indx(n,3) + du = p%du( p%Jac_u_indx(n,1) ) + ! determine which mesh we're trying to perturb and perturb the input: + SELECT CASE( p%Jac_u_indx(n,1) ) + CASE ( 1) + 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. ) + CASE ( 3) + u%CoupledKinematics(1)%TranslationVel( fieldIndx,node) = u%CoupledKinematics(1)%TranslationVel( fieldIndx,node) + du * perturb_sign + CASE ( 4) + u%CoupledKinematics(1)%RotationVel(fieldIndx,node) = u%CoupledKinematics(1)%RotationVel(fieldIndx,node) + du * perturb_sign + CASE ( 5) + u%CoupledKinematics(1)%TranslationAcc( fieldIndx,node) = u%CoupledKinematics(1)%TranslationAcc( fieldIndx,node) + du * perturb_sign + CASE ( 6) + u%CoupledKinematics(1)%RotationAcc(fieldIndx,node) = u%CoupledKinematics(1)%RotationAcc(fieldIndx,node) + du * perturb_sign + CASE (10) + u%deltaL(node) = u%deltaL(node) + du * perturb_sign + CASE (11) + u%deltaLdot(node) = u%deltaLdot(node) + du * perturb_sign + END SELECT +END SUBROUTINE MD_Perturb_u +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine uses values of two output types to compute an array of differences. +!! Do not change this packing without making sure subroutine MD_init_jacobian is consistant with this routine! +SUBROUTINE MD_Compute_dY(p, y_p, y_m, delta, dY) + TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters + TYPE(MD_OutputType) , INTENT(IN ) :: y_p !< MD outputs at \f$ u + \Delta_p u \f$ or \f$ z + \Delta_p z \f$ (p=plus) + TYPE(MD_OutputType) , INTENT(IN ) :: y_m !< MD outputs at \f$ u - \Delta_m u \f$ or \f$ z - \Delta_m z \f$ (m=minus) + REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ + REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial z_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ + ! local variables: + INTEGER(IntKi) :: i ! loop over outputs + INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled + indx_first = 1 + call PackLoadMesh_dY( y_p%CoupledLoads(1), y_m%CoupledLoads(1), dY, indx_first) + !call PackMotionMesh_dY(y_p%Y2Mesh, y_m%Y2Mesh, dY, indx_first) ! all 6 motion fields + do i=1,p%NumOuts + dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) + end do + dY = dY / (2.0_R8Ki*delta) +END SUBROUTINE MD_Compute_dY +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine perturbs the nth element of the x array (and mesh/field it corresponds to) +!! Do not change this without making sure subroutine MD_init_jacobian is consistant with this routine! +SUBROUTINE MD_Perturb_x( p, i, perturb_sign, x, dx ) + TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters + INTEGER( IntKi ) , INTENT(IN ) :: i !< state array index number + 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 +END SUBROUTINE MD_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 MD_init_jacobian is consistant with this routine! +SUBROUTINE MD_Compute_dX(p, x_p, x_m, delta, dX) + TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x_p !< 1 = more console output + + PUBLIC :: Body_Setup + PUBLIC :: Body_Initialize + PUBLIC :: Body_InitializeUnfree + PUBLIC :: Body_SetKinematics + PUBLIC :: Body_SetState + PUBLIC :: Body_SetDependentKin + PUBLIC :: Body_GetStateDeriv + PUBLIC :: Body_DoRHS + PUBLIC :: Body_GetCoupledForce + PUBLIC :: Body_AddConnect + PUBLIC :: Body_AddRod + + + +CONTAINS + + + SUBROUTINE Body_Setup( Body, tempArray, p, ErrStat, ErrMsg) + + TYPE(MD_Body), INTENT(INOUT) :: Body ! the single body object of interest + REAL(DbKi), INTENT(IN) :: tempArray(6) ! initial pose of body + TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters + 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) :: J ! Generic index + INTEGER(4) :: K ! Generic index + INTEGER(IntKi) :: N + + REAL(DbKi) :: Mtemp(6,6) + + ! set initial velocity to zero + Body%v6 = 0.0_DbKi + + !also set number of attached rods and points to zero initially + Body%nAttachedC = 0 + Body%nAttachedR = 0 + + ! set up body initial mass matrix (excluding any rods or attachements) + DO J=1,3 + Mtemp(J,J) = Body%BodyM ! fill in mass + Mtemp(3+J,3+J) = Body%BodyI(J) ! fill in inertia + END DO + + CALL TranslateMass6to6DOF(Body%rCG, Mtemp, Body%M0) ! account for potential CG offset <<< is the direction right? <<< + + DO J=1,3 + Body%M0(J,J) = Body%M0(J,J) + Body%BodyV*Body%BodyCa(J) ! add added mass in each direction about ref point (so only diagonals) <<< eventually expand to multi D + END DO + + ! --------------- if this is an independent body (not coupled) ---------- + ! set initial position and orientation of body from input file + Body%r6 = tempArray + + ! calculate orientation matrix based on latest angles + !RotMat(r6[3], r6[4], r6[5], OrMat); + Body%OrMat = TRANSPOSE( EulerConstruct( Body%r6(4:6) ) ) ! full Euler angle approach <<<< need to check order + + IF (wordy > 0) print *, "Set up Body ",Body%IdNum, ", type ", Body%typeNum + + ! need to add cleanup sub <<< + + END SUBROUTINE Body_Setup + +! ! used to initialize bodies that aren't free i.e. don't have states +! !-------------------------------------------------------------- +! SUBROUTINE Body_InitializeUnfree(Body, r6_in, mesh, mesh_index, m) +! +! Type(MD_Body), INTENT(INOUT) :: Body ! the Body object +! Real(DbKi), INTENT(IN ) :: r6_in(6) ! state vector section for this line +! TYPE(MeshType), INTENT(INOUT) :: mesh ! +! Integer(IntKi), INTENT(IN ) :: mesh_index ! index of the node in the mesh for the current object being initialized +! 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 +! REAL(DbKi) :: dummyStates(12) +! +! +! rRef = 0.0_DbKi ! <<< maybe this should be the offsets of the local platform origins from the global origins in future? And that's what's specificed by the Body input coordinates? +! +! CALL MeshPositionNode(mesh, mesh+index, rRef,ErrStat2,ErrMsg2)! "assign the coordinates (u%PtFairleadDisplacement%Position) of each node in the global coordinate space" +! +! CALL CheckError( ErrStat2, ErrMsg2 ) +! IF (ErrStat >= AbortErrLev) RETURN +! +! ! Apply offsets due to initial platform rotations and translations (fixed Jun 19, 2015) +! CALL SmllRotTrans('body rotation matrix', r6_in(4),r6_in(5),r6_in(6), OrMat, '', ErrStat2, ErrMsg2) +! mesh%TranslationDisp(1, mesh_index) = r6_in(1) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) +! mesh%TranslationDisp(2, mesh_index) = r6_in(2) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) +! mesh%TranslationDisp(3, mesh_index) = r6_in(3) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) +! +! ! what about node point orientation ??? +! +! ! If any Rod is fixed to the body (not pinned), initialize it now because otherwise it won't be initialized +! DO l=1, Body%nAttachedR +! if (m%RodList(Body%attachedR(l))%typeNum == 2) CALL Rod_Initialize(m%RodList(Body%attachedR(l)), dummyStates, m%LineList) +! END DO +! +! ! Note: Connections don't need any initialization +! +! END SUBROUTINE Body_InitializeUnfree +! !-------------------------------------------------------------- + + + ! used to initialize bodies that are free + !-------------------------------------------------------------- + SUBROUTINE Body_Initialize(Body, states, m) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Body object + Real(DbKi), INTENT(INOUT) :: states(:) ! state vector section for this Body + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + 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 + + + ! set positions of any dependent connections and rods now (before they are initialized) + CALL Body_SetDependentKin(Body, 0.0_DbKi, m) + + ! If any Rod is fixed to the body (not pinned), initialize it now because otherwise it won't be initialized + DO l=1, Body%nAttachedR + if (m%RodList(Body%attachedR(l))%typeNum == 2) CALL Rod_Initialize(m%RodList(Body%attachedR(l)), dummyStates, m) + END DO + + ! Note: Connections don't need any initialization + + END SUBROUTINE Body_Initialize + !-------------------------------------------------------------- + + ! used to initialize bodies that are coupled or fixed + !-------------------------------------------------------------- + SUBROUTINE Body_InitializeUnfree(Body, m) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Body object + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + 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 + + + ! set positions of any dependent connections and rods now (before they are initialized) + CALL Body_SetDependentKin(Body, 0.0_DbKi, m) + + ! If any Rod is fixed to the body (not pinned), initialize it now because otherwise it won't be initialized + DO l=1, Body%nAttachedR + if (m%RodList(Body%attachedR(l))%typeNum == 2) CALL Rod_Initialize(m%RodList(Body%attachedR(l)), dummyStates, m) + END DO + + ! Note: Connections don't need any initialization + + 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) + + 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 ) :: t ! instantaneous time + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects (for simplicity, since Bodies deal with Rods and Connections) + + + 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 + + ! 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 SUBROUTINE Body_SetKinematics + !-------------------------------------------------------------- + + + !-------------------------------------------------------------- + SUBROUTINE Body_SetState(Body, X, t, m) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Body object + Real(DbKi), INTENT(IN ) :: X(:) ! state vector section for this line + 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 + + ! store current time + Body%time = t + + + + Body%r6 = X(7:12) ! get positions + Body%v6 = X(1:6) ! get velocities + + + ! set positions of any dependent connections and rods + CALL Body_SetDependentKin(Body, t, m) + + END SUBROUTINE Body_SetState + !-------------------------------------------------------------- + + + ! set the states (positions and velocities) of any connects or rods that are part of this body + ! also computes the orientation matrix (never skip this sub!) + !-------------------------------------------------------------- + SUBROUTINE Body_SetDependentKin(Body, t, m) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Bodyion object + REAL(DbKi), INTENT(IN ) :: t + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects (for simplicity, since Bodies deal with Rods and Connections) + + INTEGER(IntKi) :: l ! index of attached objects + + Real(DbKi) :: rConnect(3) + Real(DbKi) :: rdConnect(3) + Real(DbKi) :: rRod(6) + Real(DbKi) :: vRod(6) + Real(DbKi) :: aRod(6) + + + + ! calculate orientation matrix based on latest angles + !CALL SmllRotTrans('', Body%r6(4), Body%r6(5), Body%r6(6), Body%TransMat, '', ErrStat2, ErrMsg2) + Body%OrMat = TRANSPOSE( EulerConstruct( Body%r6(4:6) ) ) ! full Euler angle approach <<<< need to check order + + ! set kinematics of any dependent connections + do l = 1,Body%nAttachedC + + CALL transformKinematics(Body%rConnectRel(:,l), Body%r6, Body%OrMat, Body%v6, rConnect, rdConnect) !<<< should double check this function + + ! >>> need to add acceleration terms here too? <<< + + ! pass above to the connection and get it to calculate the forces + CALL Connect_SetKinematics( m%ConnectList(Body%attachedC(l)), rConnect, rdConnect, m%zeros6(1:3), t, m) + end do + + ! set kinematics of any dependent Rods + do l=1,Body%nAttachedR + + ! calculate displaced coordinates/orientation and velocities of each rod <<<<<<<<<<<<< + ! do 3d details of Rod ref point + CALL TransformKinematicsA( Body%r6RodRel(1:3,l), Body%r6(1:3), Body%OrMat, Body%v6, Body%a6, rRod(1:3), vRod(1:3), aRod(1:3)) ! set first three entires (end A translation) of rRod and rdRod + ! does the above function need to take in all 6 elements of r6RodRel?? + + ! do rotational stuff + rRod(4:6) = MATMUL(Body%OrMat, Body%r6RodRel(4:6,l)) !<<<<<< correct? <<<<< rotateVector3(r6RodRel[i]+3, OrMat, rRod+3); ! rotate rod relative unit vector by OrMat to get unit vec in reference coords + vRod(4:6) = Body%v6(4:6) ! transformed rotational velocity. <<< is this okay as is? <<<< + aRod(4:6) = Body%a6(4:6) + + ! pass above to the rod and get it to calculate the forces + CALL Rod_SetKinematics(m%RodList(Body%attachedR(l)), rRod, vRod, aRod, t, m) + end do + + END SUBROUTINE Body_SetDependentKin + !-------------------------------------------------------------- + + + !-------------------------------------------------------------- + SUBROUTINE Body_GetStateDeriv(Body, Xd, m, p) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Bodyion 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) :: J ! index + + Real(DbKi) :: acc(6) ! 6DOF acceleration vector + + Real(DbKi) :: y_temp (6) ! temporary vector for LU decomposition + Real(DbKi) :: LU_temp(6,6) ! temporary matrix for LU decomposition + + + ! Initialize temp variables + y_temp = 0.0_DbKi +! FIXME: should LU_temp be set to M_out before calling LUsolve????? + LU_temp = 0.0_DbKi + + 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) + + ! 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 + + ! 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,") + IF (wordy > 0) print *, "state derivatives:" + IF (wordy > 0) print *, Xd + EXIT + END IF + END DO + + + END SUBROUTINE Body_GetStateDeriv + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Body_DoRHS(Body, m, p) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Bodyion object + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + !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) :: 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 + + ! Initialize variables + U = 0.0_DbKi ! Set to zero for now + Body%F6net = 0.0_DbKi + + ! First, the body's own mass matrix must be adjusted based on its orientation so that + ! we have a mass matrix in the global orientation frame + Body%M = RotateM6(Body%M0, Body%OrMat) + + !gravity on core body + Fgrav(1) = 0.0_DbKi + Fgrav(2) = 0.0_DbKi + Fgrav(3) = Body%bodyV * p%rhow * p%g - Body%bodyM * p%g ! weight+buoyancy vector + + 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 + + + ! --------------------------------- apply wave kinematics ------------------------------------ + !env->waves->getU(r6, t, U); ! call generic function to get water velocities <<<<<<<<< all needs updating + + ! for (int J=0; J<3; J++) + ! Ud[J] = 0.0; ! set water accelerations as zero for now + ! ------------------------------------------------------------------------------------------ + + ! viscous drag calculation (on core body) + 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??? <<<<<<<<<<<<<< + + + + ! Get contributions from any dependent connections + do l = 1,Body%nAttachedC + + ! get net force and mass from Connection on body ref point (global orientation) + CALL Connect_GetNetForceAndMass( m%ConnectList(Body%attachedC(l)), Body%r6(1:3), F6_i, M6_i, m, p) + + if (ABS(F6_i(5)) > 1.0E12) then + print *, "Warning: extreme pitch moment from body-attached Point ", l + end if + + ! sum quantitites + Body%F6net = Body%F6net + F6_i + Body%M = Body%M + M6_i + end do + + ! Get contributions from any dependent Rods + 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) + + if (ABS(F6_i(5)) > 1.0E12) then + print *, "Warning: extreme pitch moment from body-attached Rod ", l + end if + + ! sum quantitites + Body%F6net = Body%F6net + F6_i + Body%M = Body%M + M6_i + end do + + + 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) + + 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 + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + Real(DbKi) :: F6_iner(6) ! inertial reaction force + + ! do calculations of forces and masses on the body + CALL Body_DoRHS(Body, 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 + + else + print *, "ERROR, Body_GetCoupledForce called for wrong (non-coupled) body type in MoorDyn!" + end if + + END SUBROUTINE Body_GetCoupledForce + !-------------------------------------------------------------- + + + + ! this function handles assigning a connection to a body + !-------------------------------------------------------------- + SUBROUTINE Body_AddConnect(Body, connectID, coords) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Connection object + Integer(IntKi), INTENT(IN ) :: connectID + REAL(DbKi), INTENT(IN ) :: coords(3) + + + IF (wordy > 0) Print*, "C", connectID, "->B", Body%IdNum + + IF(Body%nAttachedC < 30) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + Body%nAttachedC = Body%nAttachedC + 1 ! increment the number connected + Body%AttachedC(Body%nAttachedC) = connectID + Body%rConnectRel(:,Body%nAttachedC) = coords ! store relative position of connect on body + ELSE + Print*, "too many Points attached to Body ", Body%IdNum, " in MoorDyn!" + END IF + + END SUBROUTINE Body_AddConnect + + + ! this function handles assigning a rod to a body + !-------------------------------------------------------------- + SUBROUTINE Body_AddRod(Body, rodID, coords) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Connection object + Integer(IntKi), INTENT(IN ) :: rodID + REAL(DbKi), INTENT(IN ) :: coords(6) ! positions of rod ends A and B relative to body + + REAL(DbKi) :: tempUnitVec(3) + REAL(DbKi) :: dummyLength + + IF (wordy > 0) Print*, "R", rodID, "->B", Body%IdNum + + IF(Body%nAttachedR < 30) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + Body%nAttachedR = Body%nAttachedR + 1 ! increment the number connected + + ! store rod ID + Body%AttachedR(Body%nAttachedR) = rodID + + ! store Rod end A relative position and unit vector from end A to B + CALL UnitVector(coords(1:3), coords(4:6), tempUnitVec, dummyLength) + Body%r6RodRel(1:3, Body%nAttachedR) = coords(1:3) + Body%r6RodRel(4:6, Body%nAttachedR) = tempUnitVec + + ELSE + Print*, "too many rods attached to Body ", Body%IdNum, " in MoorDyn" + END IF + + END SUBROUTINE Body_AddRod + + + +END MODULE MoorDyn_Body diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index 0b501336ea..582219d2fa 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -1,7 +1,7 @@ !********************************************************************************************************************************** ! LICENSING -! Copyright (C) 2020 National Renewable Energy Laboratory -! Copyright (C) 2020 Matthew Hall +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall ! ! This file is part of MoorDyn. ! @@ -27,27 +27,61 @@ PROGRAM MoorDyn_Driver IMPLICIT NONE + TYPE MD_Drvr_InitInput + LOGICAL :: Echo + REAL(DbKi) :: Gravity + REAL(DbKi) :: rhoW + REAL(DbKi) :: WtrDepth + + CHARACTER(1024) :: MDInputFile + CHARACTER(1024) :: OutRootName + REAL(DbKi) :: TMax + REAL(DbKi) :: dtC + + INTEGER :: FarmSize + REAL(DbKi) :: FarmPositions(8,40) + + INTEGER :: InputsMod + CHARACTER(1024) :: InputsFile + INTEGER :: nTurb + END TYPE MD_Drvr_InitInput + + INTEGER(IntKi) :: ErrStat ! Status of error message CHARACTER(1024) :: ErrMsg ! Error message if ErrStat /= ErrID_None - TYPE (MD_InitInputType) :: MD_InitInput - TYPE (MD_ParameterType) :: MD_Parameter - TYPE (MD_ContinuousStateType) :: MD_ContinuousState - TYPE (MD_InitOutputType) :: MD_InitOutput - TYPE (MD_DiscreteStateType) :: MD_DiscreteState - TYPE (MD_ConstraintStateType) :: MD_ConstraintState - TYPE (MD_OtherStateType) :: MD_OtherState - TYPE (MD_MiscVarType) :: MD_MiscVar + INTEGER(IntKi) :: ErrStat2 ! Status of error message + CHARACTER(1024) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None - TYPE (MD_InputType), ALLOCATABLE :: MD_Input(:) - REAL(DbKi), DIMENSION(:), ALLOCATABLE :: MD_InputTimes + 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(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 + TYPE (MD_ContinuousStateType) :: MD_x ! continuous states + TYPE (MD_InitOutputType) :: MD_InitOut + TYPE (MD_DiscreteStateType) :: MD_xd ! discrete states + TYPE (MD_ConstraintStateType) :: MD_xc ! constraint states + TYPE (MD_OtherStateType) :: MD_xo ! other states + TYPE (MD_MiscVarType) :: MD_m - TYPE (MD_OutputType) :: MD_Output ! Output file identifier + TYPE (MD_InputType), ALLOCATABLE :: MD_u(:) + REAL(DbKi), DIMENSION(:), ALLOCATABLE :: MD_uTimes + + TYPE (MD_OutputType) :: MD_y ! Output file identifier INTEGER(IntKi) :: UnPtfmMotIn ! platform motion input file identifier CHARACTER(100) :: Line ! String to temporarially hold value of read line REAL(ReKi), ALLOCATABLE :: PtfmMotIn(:,:) ! Variable for storing time, and DOF time series from driver input file - REAL(ReKi), ALLOCATABLE :: PtfmMot(:,:) ! Variable for storing interpolated DOF time series from driver input file + REAL(ReKi), ALLOCATABLE :: r_in(:,:) ! Variable for storing interpolated DOF time series from driver input file + REAL(ReKi), ALLOCATABLE :: r_in2(:,:) ! used for filtering + REAL(ReKi), ALLOCATABLE :: rd_in(:,:) ! Variable for storing 1st derivative of interpolate DOF time series + REAL(ReKi), ALLOCATABLE :: rd_in2(:,:) ! used for filtering + REAL(ReKi), ALLOCATABLE :: rdd_in(:,:) ! Variable for storing 2nd derivative of interpolate DOF time series + REAL(ReKi), ALLOCATABLE :: rdd_in2(:,:) ! used for filtering INTEGER(IntKi) :: ntIn ! number of time steps read from driver input file INTEGER(IntKi) :: ncIn ! number of channels read from driver input file INTEGER(IntKi) :: nt ! number of coupling time steps to use in simulation @@ -60,244 +94,422 @@ PROGRAM MoorDyn_Driver INTEGER(IntKi) :: MD_interp_order ! order of interpolation/extrapolation ! Local variables - Integer(IntKi) :: i ! counter for various loops - Integer(IntKi) :: j ! counter for various loops - Integer(IntKi) :: k ! counter for various loops + Integer(IntKi) :: i,j,k,l ! counter for various loops + Integer(IntKi) :: iTurb + Integer(IntKi) :: nTurbines Integer(IntKi) :: iIn integer(intKi) :: Un - + + ! data for SimStatus/RunTimes: + REAL(DbKi) :: PrevSimTime !< Previous time message was written to screen (s > 0) + REAL(ReKi) :: PrevClockTime !< Previous clock time in seconds past midnight + INTEGER :: SimStrtTime (8) !< An array containing the elements of the start time (after initialization). + INTEGER :: ProgStrtTime (8) !< An array containing the elements of the program start time (before initialization). + REAL(ReKi) :: SimStrtCPU !< User CPU time for simulation (without intialization) + REAL(ReKi) :: ProgStrtCPU !< User CPU time for program (with intialization) + + CHARACTER(20) :: FlagArg ! flag argument from command line - CHARACTER(1024) :: PlatformInitInputFile + !CHARACTER(1024) :: drvrInitInp%%InputsFile CHARACTER(200) :: git_commit ! String containing the current git commit hash TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'MoorDyn Driver', '', '' ) + + + ErrMsg = "" + ErrStat = ErrID_None + UnEcho=-1 + UnIn =-1 + + ! TODO: Sort out error handling (two sets of flags currently used) + CALL NWTC_Init( ProgNameIn=version%Name ) - MD_InitInput%FileName = "MoorDyn.dat" ! initialize to empty string to make sure it's input from the command line - CALL CheckArgs( MD_InitInput%FileName, Arg2=PlatformInitInputFile, Flag=FlagArg ) + MD_InitInp%FileName = "MoorDyn.dat" ! initialize to empty string to make sure it's input from the command line + 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) 2020 Matthew Hall' ) + CALL DispCopyrightLicense( version%Name, 'Copyright (C) 2021 NREL, 2019 Matt Hall' ) ! 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 ) - ! ------------------------------------------------------------------------- - ! Initialize MoorDyn - ! ------------------------------------------------------------------------- + + + CALL DATE_AND_TIME ( Values=ProgStrtTime ) ! Let's time the whole simulation + 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') + + ! Parse the driver input file and run the simulation based on that file + CALL get_command_argument(1, drvrFilename) + CALL ReadDriverInputFile( drvrFilename, drvrInitInp); + + ! do any initializing and allocating needed in prep for calling MD_Init + + ! set the input file name and other environment terms + !MD_InitInp%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) + MD_InitInp%Tmax = drvrInitInp%TMax + MD_InitInp%g = drvrInitInp%Gravity + MD_InitInp%rhoW = drvrInitInp%rhoW + MD_InitInp%WtrDepth = drvrInitInp%WtrDepth + MD_InitInp%FileName = drvrInitInp%MDInputFile + MD_InitInp%RootName = drvrInitInp%OutRootName + MD_InitInp%UsePrimaryInputFile = .TRUE. + !MD_InitInp%PassedPrimaryInputData = + MD_InitInp%Echo = drvrInitInp%Echo + !MD_InitInp%OutList = <<<< never used? + MD_InitInp%Linearize = .FALSE. + + TMax = drvrInitInp%TMax + dtC = drvrInitInp%dtC ! desired coupling time step size for communicating with MoorDyn - dtC = 0.01 ! desired coupling time step size for communicating with MoorDyn + ! do OpenFAST vs FAST.Farm related setup + + MD_InitInp%FarmSize = drvrInitInp%FarmSize + + 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 + nTurbines = 1 ! if a regular FAST module mode, we treat it like a nTurbine=1 farm case + end if + + CALL AllocAry(MD_InitInp%PtfmInit, 6, nTurbines, 'PtfmInit array' , ErrStat2, ErrMsg2); call AbortIfFailed() + CALL AllocAry(MD_InitInp%TurbineRefPos, 3, nTurbines, 'TurbineRefPos array', ErrStat2, ErrMsg2); call AbortIfFailed() - MD_interp_order = 0 + do J=1,nTurbines + MD_InitInp%TurbineRefPos(1,J) = drvrInitInp%FarmPositions(1,J) + MD_InitInp%TurbineRefPos(2,J) = drvrInitInp%FarmPositions(2,J) + MD_InitInp%TurbineRefPos(3,J) = 0.0_DbKi + MD_InitInp%PtfmInit(1,J) = drvrInitInp%FarmPositions(3,J) + MD_InitInp%PtfmInit(2,J) = drvrInitInp%FarmPositions(4,J) + MD_InitInp%PtfmInit(3,J) = drvrInitInp%FarmPositions(5,J) + MD_InitInp%PtfmInit(4,J) = drvrInitInp%FarmPositions(6,J)*3.14159265/180.0 + MD_InitInp%PtfmInit(5,J) = drvrInitInp%FarmPositions(7,J)*3.14159265/180.0 + MD_InitInp%PtfmInit(6,J) = drvrInitInp%FarmPositions(8,J)*3.14159265/180.0 + end do + + MD_interp_order = 1 - ! MAP: allocate Input and Output arrays; used for interpolation and extrapolation - Allocate(MD_InputTimes(MD_interp_order + 1)) + ! allocate Input and Output arrays; used for interpolation and extrapolation + Allocate(MD_uTimes(MD_interp_order + 1)) ! @bonnie : This is in the FAST developers glue code example, but it's probably not needed here. - Allocate(MD_Input(MD_interp_order + 1)) + Allocate(MD_u(MD_interp_order + 1)) - ! set the input file name and other environment terms. - !MD_InitInput%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) - MD_InitInput%g = 9.81 ! This need to be according to g used in ElastoDyn - MD_InitInput%rhoW = 1025 ! This needs to be set according to seawater density in HydroDyn - MD_InitInput%PtfmInit = 0.0 - MD_InitInput%RootName = "MoorDyn.MD" + + if (drvrInitInp%InputsMod > 1) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = ' ERROR: MoorDyn Driver InputsMod must be 0 or 1.' + CALL AbortIfFailed() + end if + + ! -------------------------------- ----------------------------------- + + ! 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 + + ! 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_InitInput , & - MD_Input(1) , & - MD_Parameter , & - MD_ContinuousState , & - MD_DiscreteState , & - MD_ConstraintState , & - MD_OtherState , & - MD_Output , & - MD_MiscVar , & - dtC , & - MD_InitOutput , & - ErrStat , & - ErrMsg ) - IF ( ErrStat .NE. ErrID_None ) THEN - IF (ErrStat >=AbortErrLev) CALL ProgAbort(ErrMsg) - CALL WrScr( ErrMsg ) - END IF + 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_DestroyInitInput ( MD_InitInput , ErrStat, ErrMsg ) - CALL MD_DestroyInitOutput ( MD_InitOutput , ErrStat, ErrMsg ) + CALL MD_DestroyInitInput ( MD_InitInp , ErrStat, ErrMsg ); call AbortIfFailed() + CALL MD_DestroyInitOutput ( MD_InitOut , ErrStat, ErrMsg ); call AbortIfFailed() - CALL DispNVD( MD_InitOutput%Ver ) + CALL DispNVD( MD_InitOut%Ver ) - ncIn = 6 + size(MD_Input(1)%DeltaL) ! determine number of input channels expected from driver input file time series (DOFs including active tensioning channels) + ! determine number of input channels expected from driver input file time series (DOFs including active tensioning channels) + ncIn = size(MD_u(1)%DeltaL) - ! ------------------------------------------------------------------------- - ! Read in prescribed motions from text file if available - ! (single 6DOF platform for now, plus one active tensioning command) - ! (to be updated for versatile coupling in future) - ! ------------------------------------------------------------------------- - IF( LEN( TRIM(PlatformInitInputFile) ) < 1 ) THEN - ntIn = 0 ! flag to indicate no motion input file - print *, "No MoorDyn Driver input file provided, so using zero values." + do iTurb = 1, MD_p%nTurbines + ncIn = ncIn + MD_p%nCpldBodies(iTurb)*6 + MD_p%nCpldRods(iTurb)*6 + MD_p%nCpldCons(iTurb)*3 + end do + + print *, 'MoorDyn has '//trim(num2lstr(ncIn))//' coupled DOFs and/or active-tensioned inputs.' - ELSE - CALL GetNewUnit( UnPtfmMotIn ) - CALL OpenFInpFile ( UnPtfmMotIn, PlatformInitInputFile, ErrStat, ErrMsg ) - IF (ErrStat /= 0 ) THEN - print *, ErrStat, ErrMsg - STOP - ENDIF - print *, "Reading platform motion input data from ", PlatformInitInputFile + 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 2.' + CALL AbortIfFailed() + end if + + CALL GetNewUnit( UnPtfmMotIn ) + + CALL OpenFInpFile ( UnPtfmMotIn, drvrInitInp%InputsFile, ErrStat2, ErrMsg2 ); call AbortIfFailed() + + print *, 'Reading platform motion input data from ', trim(drvrInitInp%InputsFile) + print *, 'MD driver is expecting '//trim(num2lstr(ncIn))//' columns of input data, plus time, in motion input file.' ! Read through length of file to find its length i = 1 ! start counter DO - READ(UnPtfmMotIn,'(A)',IOSTAT=ErrStat) Line !read into a line - - - IF (ErrStat /= 0) EXIT - - print *, TRIM(Line) + READ(UnPtfmMotIn,'(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) + !print *, TRIM(Line) i = i+1 END DO ! rewind to start of input file to re-read things now that we know how long it is REWIND(UnPtfmMotIn) - - ntIn = i-1 ! save number of lines of file + + ErrStat2 = 0 ! reset the error state after it may be used to exit the loop above + + ntIn = i-3 ! save number of lines of file ! allocate space for input motion array (including time column) - ALLOCATE ( PtfmMotIn(ntIn, ncIn+1), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN + ALLOCATE ( PtfmMotIn(ntIn, ncIn+1), STAT=ErrStat2) + IF ( ErrStat2 /= ErrID_None ) THEN + ErrStat = ErrID_Fatal ErrMsg = ' Error allocating space for PtfmMotIn array.' - CALL WrScr( ErrMsg ) - END IF + call AbortIfFailed() + END IF ! read the data in from the file + READ(UnPtfmMotIn,'(A)',IOSTAT=ErrStat2) Line !read into a line + READ(UnPtfmMotIn,'(A)',IOSTAT=ErrStat2) Line !read into a line + DO i = 1, ntIn - READ (UnPtfmMotIn,*,IOSTAT=ErrStat) (PtfmMotIn (i,J), J=1,ncIn+1) + READ (UnPtfmMotIn, *, IOSTAT=ErrStat2) (PtfmMotIn (i,J), J=1,ncIn+1) - IF ( ErrStat /= 0 ) THEN - ErrMsg = ' Error reading the input time-series file. Expecting '//TRIM(Int2LStr(ncIn))//' channels plus time.' - CALL WrScr( ErrMsg ) + IF ( ErrStat2 /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error reading the input time-series file. Expecting '//TRIM(Int2LStr(ncIn))//' channels plus time.' + call AbortIfFailed() END IF END DO - ! Close the inputs file + ! Close the inputs file CLOSE ( UnPtfmMotIn ) print *, "Read ", ntIn, " time steps from input file." - print *, PtfmMotIn + !print *, PtfmMotIn - END IF + ! trim simulation duration to length of input file if needed + if (PtfmMotIn(ntIn, 1) < TMax) then + TMax = PtfmMotIn(ntIn, 1) + end if + - ! ----------------------- specify stepping details ----------------------- + ! specify stepping details + nt = tMax/dtC - 1 ! number of coupling time steps - IF (ntIn > 0) THEN - tMax = PtfmMotIn(ntIn, 1) ! save last time step as total sim time - ELSE - tMax = 60 - END IF - + + ! 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.' + call AbortIfFailed() + END IF - nt = tMax/dtC - 1 ! number of coupling time steps - CALL WrScr(" ") - print *, "Tmax - ", tMax, " and nt=", nt - CALL WrScr(" ") + ! go through and interpolate inputs to new regular time steps (if nt=0 this array should be left as zeros) - ! allocate space for processed motion array - ALLOCATE ( PtfmMot(nt, ncIn), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating space for PtfmMot array.' - CALL WrScr( ErrMsg ) - END IF - - - ! go through and interpolate inputs to new regular time steps (if nt=0 this array should be left as zeros) - IF (ntIn > 0) THEN - DO i = 1,nt - + DO i = 1,nt t = dtC*(i-1) - ! interpolation routine + ! interpolation routine DO iIn = 1,ntIn-1 - IF (PtfmMotIn(iIn+1, 1) > t) THEN - frac = (t - PtfmMotIn(iIn, 1) )/( PtfmMotIn(iIn+1, 1) - PtfmMotIn(iIn, 1) ) - - ! print *, "t=", t, ", iIn=", iIn, ", frac=", frac + IF (PtfmMotIn(iIn+1, 1) > t) THEN ! find the right two points to interpolate between (remember that the first column of PtfmMotIn is time) + frac = (t - PtfmMotIn(iIn, 1) )/( PtfmMotIn(iIn+1, 1) - PtfmMotIn(iIn, 1) ) ! interpolation fraction (0-1) between two interpolation points DO J=1,ncIn - PtfmMot(i, J) = PtfmMotIn(iIn, J+1) + frac*(PtfmMotIn(iIn+1, J+1) - PtfmMotIn(iIn, J+1)) + ! get interpolated position of coupling point + r_in(i, J) = PtfmMotIn(iIn, J+1) + frac*(PtfmMotIn(iIn+1, J+1) - PtfmMotIn(iIn, J+1)) + + if (iIn==1) then + ! use forward different to estimate velocity of coupling point + rd_in(i, J) = (PtfmMotIn(iIn+1, J+1) - PtfmMotIn(iIn, J+1)) / (PtfmMotIn(iIn+1, 1) - PtfmMotIn(iIn, 1)) + else + ! use central different to estimate velocity of coupling point + rd_in(i, J) = (PtfmMotIn(iIn+1, J+1) - PtfmMotIn(iIn-1, J+1)) / (PtfmMotIn(iIn+1, 1) - PtfmMotIn(iIn-1, 1)) + + end if END DO - EXIT + EXIT ! break out of the loop for this time step once we've done its interpolation END IF END DO - ! print *, t, "s", PtfmMot(i,:) + END DO + ! ----- filter position ----- + ! now filter forward + DO i = 1,nt + DO J=1,ncIn + if (i==1) then + r_in2(i, J) = r_in(i, J) + else + r_in2(i, J) = 0.1*r_in(i, J) + 0.9*r_in2(i-1, J) + end if + END DO + END DO + ! now filter backward and save back to original variable + DO i = nt,1,-1 + DO J=1,ncIn + if (i==nt) then + r_in(i, J) = r_in2(i, J) + else + r_in(i, J) = 0.1*r_in2(i, J) + 0.9*r_in(i+1, J) + end if + END DO END DO - ELSE - PtfmMot = 0.0_Reki - END IF - + ! now get derivative after filtering has been applied (derivative no longer needs to be calculated earlier) + DO i = 1,nt + DO J=1,ncIn + if (i==1) then + ! use forward different to estimate velocity of coupling point + rd_in(i, J) = (r_in(i+1, J) - r_in(i, J)) / dtC + else if (i==nt) then + ! use forward different to estimate velocity of coupling point + rd_in(i, J) = (r_in(i, J) - r_in(i-1, J)) / dtC + else + ! use central different to estimate velocity of coupling point + rd_in(i, J) = (r_in(i+1, J) - r_in(i-1, J)) / (2.0*dtC) + end if + END DO + END DO + + + + ! ----- filter velocity ----- + ! now filter forward + DO i = 1,nt + DO J=1,ncIn + if (i==1) then + rd_in2(i, J) = rd_in(i, J) + else + rd_in2(i, J) = 0.1*rd_in(i, J) + 0.9*rd_in2(i-1, J) + end if + END DO + END DO + ! now filter backward and save back to original variable + DO i = nt,1,-1 + DO J=1,ncIn + if (i==nt) then + rd_in(i, J) = rd_in2(i, J) + else + rd_in(i, J) = 0.1*rd_in2(i, J) + 0.9*rd_in(i+1, J) + end if + END DO + END DO + + + ! now get derivative after filtering has been applied (derivative no longer needs to be calculated earlier) + DO i = 1,nt + DO J=1,ncIn + if (i==1) then + ! use forward different to estimate velocity of coupling point + rdd_in(i, J) = (rd_in(i+1, J) - rd_in(i, J)) / dtC + else if (i==nt) then + ! use forward different to estimate velocity of coupling point + rdd_in(i, J) = (rd_in(i, J) - rd_in(i-1, J)) / dtC + else + ! use central different to estimate velocity of coupling point + rdd_in(i, J) = (rd_in(i+1, J) - rd_in(i-1, J)) / (2.0*dtC) + end if + END DO + END DO + + + ! ----- filter acceleration ----- + ! now filter forward + DO i = 1,nt + DO J=1,ncIn + if (i==1) then + rdd_in2(i, J) = rdd_in(i, J) + else + rdd_in2(i, J) = 0.2*rdd_in(i, J) + 0.8*rdd_in2(i-1, J) + end if + END DO + END DO + ! now filter backward and save back to original variable + DO i = nt,1,-1 + DO J=1,ncIn + if (i==nt) then + rdd_in(i, J) = rdd_in2(i, J) + else + rdd_in(i, J) = 0.2*rdd_in2(i, J) + 0.8*rdd_in(i+1, J) + end if + END DO + END DO + + + else + nt = tMax/dtC - 1 ! number of coupling time steps + end if + CALL WrScr(" ") + print *, "Tmax - ", tMax, " and nt=", nt + CALL WrScr(" ") ! --------------------------------------------------------------- ! Set the initial input values ! --------------------------------------------------------------- - - ! start with zeros >>> or should this be the initial row of DOFs? <<< - MD_Input(1)%PtFairleadDisplacement%TranslationDisp = 0.0_ReKi - MD_Input(1)%DeltaL = 0.0_ReKi - MD_Input(1)%DeltaLdot = 0.0_ReKi + ! zero the tension commands + MD_u(1)%DeltaL = 0.0_ReKi + MD_u(1)%DeltaLdot = 0.0_ReKi + +! ! zero water inputs (if passing wave info in from glue code) +! MD_u(1)%U = 0.0 +! MD_u(1)%Ud = 0.0 +! MD_u(1)%zeta = 0.0 +! MD_u(1)%PDyn = 0.0 +! ! now add some current in x for testing +! MD_u(1)%U(1,:) = 1.0 + + ! copy inputs to initialize input arrays for higher interp orders if applicable DO i = 2, MD_interp_order + 1 - CALL MD_CopyInput( MD_Input(1), MD_Input(i), MESH_NEWCOPY, ErrStat, ErrMsg ) - END DO - + CALL MD_CopyInput( MD_u(1), MD_u(i), MESH_NEWCOPY, ErrStat2, ErrMsg2 ); call AbortIfFailed() + END DO DO i = 1, MD_interp_order + 1 - MD_InputTimes(i) = -(i - 1) * dtC - ENDDO - + MD_uTimes(i) = -(i - 1) * dtC + END DO + ! get output at initialization (before time stepping) t = 0 + CALL MD_CalcOutput( t, MD_u(1), MD_p, MD_x, MD_xd, MD_xc , MD_xo, MD_y, MD_m, ErrStat2, ErrMsg2 ); call AbortIfFailed() - CALL MD_CalcOutput( t , & - MD_Input(1) , & - MD_Parameter , & - MD_ContinuousState , & - MD_DiscreteState , & - MD_ConstraintState , & - MD_OtherState , & - MD_Output , & - MD_MiscVar , & - ErrStat , & - ErrMsg ) - IF ( ErrStat .NE. ErrID_None ) THEN - IF (ErrStat >=AbortErrLev) CALL ProgAbort(ErrMsg) - CALL WrScr( ErrMsg ) - END IF ! ------------------------------------------------------------------------- - ! BEGIN time marching >>> note that 3 rotational platform DOFs are currently neglected <<< + ! BEGIN time marching ! ------------------------------------------------------------------------- - + print *,"Doing time marching now..." + + CALL SimStatus_FirstTime( PrevSimTime, PrevClockTime, SimStrtTime, SimStrtCPU, t, tMax ) DO i = 1,nt @@ -305,77 +517,98 @@ PROGRAM MoorDyn_Driver t = dtC*(i-1) - MD_InputTimes(1) = t + dtC - !MD_InputTimes(2) = MD_InputTimes(1) - dtC - !MD_InputTimes(3) = MD_InputTimes(2) - dtC - ! apply platform translations (neglecting rotations for now) - MD_Input(1)%PtFairleadDisplacement%TranslationDisp(1,1) = PtfmMot(i, 1) - MD_Input(1)%PtFairleadDisplacement%TranslationDisp(1,2) = PtfmMot(i, 2) - MD_Input(1)%PtFairleadDisplacement%TranslationDisp(1,3) = PtfmMot(i, 3) + if ( MOD( i, 20 ) == 0 ) THEN + CALL SimStatus( PrevSimTime, PrevClockTime, t, tMax ) + end if + + ! shift older inputs back in the buffer + CALL MD_CopyInput( MD_u(1), MD_u(2), MESH_NEWCOPY, ErrStat2, ErrMsg2 ); call AbortIfFailed() ! copy from 1 to 2 before 1 is updated with latest. + MD_uTimes(1) = t + dtC + 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 + 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)%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) + MD_u(1)%CoupledKinematics(iTurb)%TranslationAcc( :,K) = rdd_in(i, J:J+2) + MD_u(1)%CoupledKinematics(iTurb)%RotationAcc( :,K) = rdd_in(i, J+3:J+5) + + K = K + 1 + J = J + 6 + END DO + + ! 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)%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) + MD_u(1)%CoupledKinematics(iTurb)%TranslationAcc( :,K) = rdd_in(i, J:J+2) + MD_u(1)%CoupledKinematics(iTurb)%RotationAcc( :,K) = rdd_in(i, J+3:J+5) + + K = K + 1 + J = J + 6 + END DO + + ! any coupled points (type -1) + DO l = 1, MD_p%nCpldCons(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) + + !print *, u%PtFairleadDisplacement%Position(:,l) + u%PtFairleadDisplacement%TranslationDisp(:,l) + !print *, u%PtFairleadDisplacement%TranslationVel(:,l) + + K = K + 1 + J = J + 3 + END DO + + end do ! iTurb + + ! also provide any active tensioning commands + do l = 1, size(MD_u(1)%DeltaL) + + MD_u(1)%DeltaL( l) = 0.0_DbKi ! r_in(i, J) + MD_u(1)%DeltaLdot(l) = 0.0_DbKi !rd_in(i, J) - !MD_Input(2)%PtFairleadDisplacement%TranslationDisp(1,1) = .001*n_t_global - !MD_Input(3)%PtFairleadDisplacement%TranslationDisp(1,1) = .001*n_t_global + J = J + 1 + end do - ! what about velocities?? + end if ! InputsMod == 1 - ! also provide any active tensioning commands (just using delta L, and finite differencing to get derivative) - DO j = 1,ncIn-6 + ! >>> otherwise, mesh kinematics should all still be zero ... maybe worth checking <<< - MD_Input(1)%DeltaL(j) = PtfmMot(i, 6+j) - - IF (i>1) then - MD_Input(1)%DeltaLdot(j) = (PtfmMot(i, 6+j) - PtfmMot(i-1, 6+j))/dtC - ELSE - MD_Input(1)%DeltaLdot(j) = 0.0_ReKi - END IF - - END DO ! --------------------------------- update states --------------------------------- - CALL MD_UpdateStates( t , & - nt , & - MD_Input , & - MD_InputTimes , & - MD_Parameter , & - MD_ContinuousState , & - MD_DiscreteState , & - MD_ConstraintState , & - MD_OtherState , & - MD_MiscVar , & - ErrStat , & - ErrMsg ) - IF ( ErrStat .NE. ErrID_None ) THEN - IF (ErrStat >=AbortErrLev) CALL ProgAbort(ErrMsg) - CALL WrScr( ErrMsg ) - EXIT - END IF + 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() + ! update the global time step by one delta t <<<< ??? why? t = t + dtC ! --------------------------------- calculate outputs --------------------------------- - CALL MD_CalcOutput( t , & - MD_Input(1) , & - MD_Parameter , & - MD_ContinuousState , & - MD_DiscreteState , & - MD_ConstraintState , & - MD_OtherState , & - MD_Output , & - MD_MiscVar , & - ErrStat , & - ErrMsg ) - IF ( ErrStat .NE. ErrID_None ) THEN - IF (ErrStat >=AbortErrLev) CALL ProgAbort(ErrMsg) - CALL WrScr( ErrMsg ) - END IF - - - WRITE(Un,100) t, MD_Input(1)%PtFairleadDisplacement%TranslationDisp(1,1), & - ((MD_Output%PtFairleadLoad%Force(k,j), k=1,3),j=1,3) + CALL MD_CalcOutput( t, MD_u(1), MD_p, MD_x, MD_xd, MD_xc, MD_xo, MD_y, MD_m, ErrStat2, ErrMsg2 ); call AbortIfFailed() + + + ! >>> should make output vector to hold and print outputs <<< + !WRITE(Un, *) t, MD_u(1)%CoupledKinematics(1)%TranslationDisp(1,1), ((MD_y%CoupledLoads(1)%Force(k,j), k=1,3),j=1,3) !WRITE(*,*) t_global + ! FORMAT(2(1X,F8.3),9(1X,E12.5)) + END DO @@ -383,35 +616,142 @@ PROGRAM MoorDyn_Driver ! END time marching ! ------------------------------------------------------------------------- + CALL RunTimes( ProgStrtTime, ProgStrtCPU, SimStrtTime, SimStrtCPU, t ) + ! Destroy all objects - CALL MD_End( MD_Input(1) , & - MD_Parameter , & - MD_ContinuousState , & - MD_DiscreteState , & - MD_ConstraintState , & - MD_OtherState , & - MD_Output , & - MD_MiscVar , & - ErrStat , & - ErrMsg ) - IF ( ErrStat .NE. ErrID_None ) THEN - IF (ErrStat >=AbortErrLev) CALL ProgAbort(ErrMsg) - CALL WrScr( ErrMsg ) - END IF + 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_Input(j), ErrStat, ErrMsg) + call MD_DestroyInput( MD_u(j), ErrStat, ErrMsg) end do - DEALLOCATE(MD_Input) - DEALLOCATE(MD_InputTimes) + DEALLOCATE(MD_u) + DEALLOCATE(MD_uTimes) - IF (ALLOCATED(PtfmMot) ) DEALLOCATE(PtfmMot ) + IF (ALLOCATED(r_in) ) DEALLOCATE(r_in ) IF (ALLOCATED(PtfmMotIn)) DEALLOCATE(PtfmMotIn) CALL WrScr( "Program has ended" ) close (un) -100 FORMAT(2(1X,F8.3),9(1X,E12.5)) - - END PROGRAM \ No newline at end of file + +CONTAINS + + SUBROUTINE AbortIfFailed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver') + IF ( ErrStat /= ErrID_None ) THEN + CALL WrScr( ErrMsg2 ) + CALL WrScr( 'hi1') + CALL WrScr( ErrMsg ) + CALL WrScr( 'hi1') + END IF + if (ErrStat >= AbortErrLev) then + call CleanUp() + STOP + endif + 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) + END SUBROUTINE CleanUp + + !------------------------------------------------------------------------------------------------------------------------------- + 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) :: FileName ! Name of MoorDyn input file + CHARACTER(1024) :: FilePath ! Path Name of MoorDyn input file + + UnEcho=-1 + UnIn =-1 + + FileName = TRIM(inputFile) + + CALL GetNewUnit( UnIn ) + CALL OpenFInpFile( UnIn, FileName, ErrStat2, ErrMsg2); + call AbortIfFailed() + + CALL WrScr( 'Opening MoorDyn Driver input file: '//FileName ) + + ! 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 + !---------------------- ENVIRONMENTAL CONDITIONS ------------------------------------------------- + CALL ReadCom( UnIn, FileName, 'Environmental conditions header', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%Gravity, 'Gravity', 'Gravity', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%rhoW , 'rhoW', 'water density', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%WtrDepth, 'WtrDepth', 'water depth', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + !---------------------- MoorDyn ------------------------------------------------------------------- + CALL ReadCom( UnIn, FileName, 'MoorDyn header', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%MDInputFile, 'MDInputFile', 'MoorDyn input filename', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%OutRootName, 'OutRootName', 'MoorDyn output root filename', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%TMax , 'Tmax', 'Simulation time duration', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%dtC , 'dtC', 'Time step size for calling MoorDyn', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%InputsMod , 'InputsMode', 'Mode for the inputs - zero/steady/time-series', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%InputsFile , 'InputsFile', 'Filename for the MoorDyn inputs', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%FarmSize , 'NumTurbines', 'number of turbines in FAST.Farm', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadCom( UnIn, FileName, 'Initial positions header', ErrStat2, ErrMsg2); call AbortIfFailed() + CALL ReadCom( UnIn, FileName, 'Initial positions table header line 1', ErrStat2, ErrMsg2); call AbortIfFailed() + CALL ReadCom( UnIn, FileName, 'Initial positions table header line 2', ErrStat2, ErrMsg2); call AbortIfFailed() + do J=1,MAX(1,InitInp%FarmSize) + CALL ReadAry( UnIn, FileName, InitInp%FarmPositions(:,J), 8, "FarmPositions", "FAST.Farm position inputs", ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + end do + + ! done reading + if(UnEcho>0) CLOSE( UnEcho ) + if(UnIn>0) CLOSE( UnIn ) + + ! 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 + + END SUBROUTINE ReadDriverInputFile + + subroutine print_help() + print '(a)', 'usage: ' + print '(a)', '' + print '(a)', 'MoorDynDriver.exe driverfilename' + print '(a)', '' + print '(a)', 'Where driverfilename is the name of the MoorDyn driver input file.' + print '(a)', '' + end subroutine print_help +!---------------------------------------------------------------------------------------------------------------------------------- + + +END PROGRAM diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index 2eb3c9a67b..577e6117f2 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -1,6 +1,7 @@ !********************************************************************************************************************************** ! LICENSING -! Copyright (C) 2015 Matthew Hall +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall ! ! This file is part of MoorDyn. ! @@ -28,6 +29,11 @@ MODULE MoorDyn_IO PRIVATE + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output + + INTEGER, PARAMETER :: nCoef = 30 ! maximum number of entries to allow in nonlinear coefficient lookup tables + ! it would be nice if the above worked for everything, but I think it needs to also be matched in the Registry + ! --------------------------- Output definitions ----------------------------------------- ! The following are some definitions for use with the output options in MoorDyn. @@ -41,8 +47,7 @@ MODULE MoorDyn_IO ! QType - (int) the type of quantity to output. 0=tension, 1=x pos, etc. see the parameters below ! NodeID - (int) the ID number of the node of the output quantity - ! These are the "OTypes": 0=Connect object, 1=Line Object - ! (will just use 0 and 1 rather than parameter names) + ! These are the "OTypes": 1=Line, 2=Connect, 3=Rod, 4=Body ! Indices for computing output channels: - customized for the MD_OutParmType approach ! these are the "QTypes" @@ -56,17 +61,26 @@ MODULE MoorDyn_IO INTEGER, PARAMETER :: AccX = 7 INTEGER, PARAMETER :: AccY = 8 INTEGER, PARAMETER :: AccZ = 9 - INTEGER, PARAMETER :: Ten = 10 - INTEGER, PARAMETER :: FX = 11 - INTEGER, PARAMETER :: FY = 12 - INTEGER, PARAMETER :: FZ = 13 + INTEGER, PARAMETER :: Ten = 10 + INTEGER, PARAMETER :: FX = 11 + INTEGER, PARAMETER :: FY = 12 + INTEGER, PARAMETER :: FZ = 13 + INTEGER, PARAMETER :: MX = 14 + INTEGER, PARAMETER :: MY = 15 + INTEGER, PARAMETER :: MZ = 16 + INTEGER, PARAMETER :: Pitch = 17 + INTEGER, PARAMETER :: Roll = 18 + INTEGER, PARAMETER :: Yaw = 19 + INTEGER, PARAMETER :: Sub = 20 ! List of units corresponding to the quantities parameters for QTypes - CHARACTER(ChanLen), PARAMETER :: UnitList(0:13) = (/ & + CHARACTER(ChanLen), PARAMETER :: UnitList(0:20) = (/ & "(s) ","(m) ","(m) ","(m) ", & "(m/s) ","(m/s) ","(m/s) ", & "(m/s2) ","(m/s2) ","(m/s2) ", & - "(N) ","(N) ","(N) ","(N) " /) + "(N) ","(N) ","(N) ","(N) ", & + "(Nm) ","(Nm) ","(Nm) ", & + "(deg) ","(deg) ","(deg) ","(frac) "/) CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. CHARACTER(28), PARAMETER :: OutSFmt = "ES10.3E2" @@ -84,7 +98,11 @@ MODULE MoorDyn_IO - PUBLIC :: MDIO_ReadInput + ! PUBLIC :: MDIO_ReadInput + PUBLIC :: setupBathymetry + PUBLIC :: getCoefficientOrCurve + PUBLIC :: SplitByBars + PUBLIC :: DecomposeString PUBLIC :: MDIO_OpenOutput PUBLIC :: MDIO_CloseOutput PUBLIC :: MDIO_ProcessOutList @@ -94,525 +112,280 @@ MODULE MoorDyn_IO CONTAINS + SUBROUTINE setupBathymetry(inputString, defaultDepth, BathGrid, BathGrid_Xs, BathGrid_Ys, ErrStat3, ErrMsg3) + ! SUBROUTINE getBathymetry(inputString, BathGrid, BathGrid_Xs, BathGrid_Ys, BathGrid_npoints, ErrStat3, ErrMsg3) + CHARACTER(40), INTENT(IN ) :: inputString ! string describing water depth or bathymetry filename + REAL(ReKi), INTENT(IN ) :: defaultDepth ! depth to use if inputString is empty + REAL(DbKi), ALLOCATABLE, INTENT(INOUT) :: BathGrid (:,:) + REAL(DbKi), ALLOCATABLE, INTENT(INOUT) :: BathGrid_Xs (:) + REAL(DbKi), ALLOCATABLE, INTENT(INOUT) :: BathGrid_Ys (:) + INTEGER(IntKi), INTENT( OUT) :: ErrStat3 ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg3 ! Error message if ErrStat /= ErrID_None - !==================================================================================================== - SUBROUTINE MDIO_ReadInput( InitInp, p, m, ErrStat, ErrMsg ) - - ! This subroutine reads the input required for MoorDyn from the file whose name is an - ! input parameter. It sets the size of p%NTypes, NConnects, and NLines, - ! allocates LineTypeList, ConnectList, and LineList, and puts all the read contents of - ! the input file into the respective slots in those lists of types. - - - ! Passed variables - - TYPE(MD_InitInputType), INTENT( INOUT ) :: InitInp ! the MoorDyn data - TYPE(MD_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(MD_MiscVarType), INTENT( OUT) :: m ! INTENT( OUT) : Initial misc/optimization vars - 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 - INTEGER :: UnIn ! Unit number for the input file - INTEGER :: UnEc ! The local unit number for this module's 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 - CHARACTER(20) :: OptValue ! String to temporarially hold value of options variable input - CHARACTER(1024) :: FileName ! - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MDIO_ReadInput' - - - ! - UnEc = -1 - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! Open the file - !------------------------------------------------------------------------------------------------- - FileName = TRIM(InitInp%FileName) - - 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( ' MD_Init: Opening MoorDyn input file: '//FileName ) - - - !------------------------------------------------------------------------------------------------- - ! File header - !------------------------------------------------------------------------------------------------- - - CALL ReadCom( UnIn, FileName, 'MoorDyn input file header line 1', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - CALL ReadCom( UnIn, FileName, 'MoorDyn input file header line 2', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! 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. - - IF ( InitInp%Echo ) THEN - - !print *, 'gonna try to open echo file' - - EchoFile = TRIM(p%RootName)//'.ech' ! open an echo file for writing - - !print *, 'name is ', EchoFile - - CALL GetNewUnit( UnEc ) - CALL OpenEcho ( UnEc, EchoFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - REWIND(UnIn) ! rewind to start of input file to re-read the first few lines - - - - - CALL ReadCom( UnIn, FileName, 'MoorDyn input 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, FileName, 'MoorDyn input file header line 2', ErrStat2, ErrMsg2, UnEc ) - 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, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - !print *, 'at end of echo if statement' - - END IF - - - !------------------------------------------------------------------------------------------------- - ! Line Types Properties Section - !------------------------------------------------------------------------------------------------- - - CALL ReadCom( UnIn, FileName, 'Line types header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - CALL ReadVar ( UnIn, FileName, p%NTypes, 'NTypes', 'Number of line types', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Table header - DO I = 1, 2 - CALL ReadCom( UnIn, FileName, 'Line types table header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - END DO - - ! make sure NTypes isn't zero - IF ( p%NTypes < 1 ) THEN - CALL SetErrStat( ErrID_Fatal, 'NTypes parameter must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - ! Allocate memory for LineTypeList array to hold line type properties - ALLOCATE ( m%LineTypeList(p%NTypes), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating space for LineTypeList array.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - ! read each line - DO I = 1,p%NTypes - ! read the table entries Name Diam MassDenInAir EA cIntDamp Can Cat Cdn Cdt in the MoorDyn input file - READ(UnIn,'(A)',IOSTAT=ErrStat2) Line !read into a line - - IF (ErrStat2 == 0) THEN - READ(Line,*,IOSTAT=ErrStat2) m%LineTypeList(I)%name, m%LineTypeList(I)%d, & - m%LineTypeList(I)%w, m%LineTypeList(I)%EA, m%LineTypeList(I)%BA, & - m%LineTypeList(I)%Can, m%LineTypeList(I)%Cat, m%LineTypeList(I)%Cdn, m%LineTypeList(I)%Cdt - END IF - - m%LineTypeList(I)%IdNum = I ! specify IdNum of line type for error checking - - - IF ( ErrStat2 /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal, 'Failed to read line type properties for line '//trim(Num2LStr(I)), ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - IF ( InitInp%Echo ) THEN - WRITE( UnEc, '(A)' ) TRIM(Line) - END IF - - END DO - - - - !------------------------------------------------------------------------------------------------- - ! Connections Section - !------------------------------------------------------------------------------------------------- - - CALL ReadCom( UnIn, FileName, 'Connections header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - CALL ReadVar ( UnIn, FileName, p%NConnects, 'NConnects', 'Number of Connects', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Table header - DO I = 1, 2 - CALL ReadCom( UnIn, FileName, 'Connects header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - END DO - - ! make sure NConnects is at least two - IF ( p%NConnects < 2 ) THEN - ErrMsg = ' NConnects parameter must be at least 2.' - CALL CleanUp() - RETURN - END IF - - ! allocate ConnectList - ALLOCATE ( m%ConnectList(p%NConnects), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating space for ConnectList array.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - - ! read each line - DO I = 1,p%NConnects - ! read the table entries Node Type X Y Z M V FX FY FZ Cda Ca - READ(UnIn,'(A)',IOSTAT=ErrStat2) Line !read into a line - - IF (ErrStat2 == 0) THEN - READ(Line,*,IOSTAT=ErrStat2) m%ConnectList(I)%IdNum, m%ConnectList(I)%type, m%ConnectList(I)%conX, & - m%ConnectList(I)%conY, m%ConnectList(I)%conZ, m%ConnectList(I)%conM, & - m%ConnectList(I)%conV, m%ConnectList(I)%conFX, m%ConnectList(I)%conFY, & - m%ConnectList(I)%conFZ, m%ConnectList(I)%conCdA, m%ConnectList(I)%conCa - END IF - - IF ( ErrStat2 /= 0 ) THEN - CALL WrScr(' Unable to parse Connection '//trim(Num2LStr(I))//' row in input file.') ! Specific screen output because errors likely - CALL WrScr(' Ensure row has all 12 columns, including CdA and Ca.') ! to be caused by non-updated input file formats. - CALL SetErrStat( ErrID_Fatal, 'Failed to read connects.' , ErrStat, ErrMsg, RoutineName ) ! would be nice to specify which line <<<<<<<<< - CALL CleanUp() - RETURN - END IF - - ! check for sequential IdNums - IF ( m%ConnectList(I)%IdNum .NE. I ) THEN - CALL SetErrStat( ErrID_Fatal, 'Node numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - - - - IF ( InitInp%Echo ) THEN - WRITE( UnEc, '(A)' ) TRIM(Line) - END IF - - END DO - - - !------------------------------------------------------------------------------------------------- - ! Lines Section - !------------------------------------------------------------------------------------------------- + INTEGER(IntKi) :: I + INTEGER(IntKi) :: UnCoef ! unit number for coefficient input file + + INTEGER(IntKi) :: ErrStat4 + CHARACTER(120) :: ErrMsg4 + CHARACTER(120) :: Line2 - CALL ReadCom( UnIn, FileName, 'Lines header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + CHARACTER(20) :: nGridX_string ! string to temporarily hold the nGridX string from Line2 + CHARACTER(20) :: nGridY_string ! string to temporarily hold the nGridY string from Line3 + INTEGER(IntKi) :: nGridX ! integer of the size of BathGrid_Xs + INTEGER(IntKi) :: nGridY ! integer of the size of BathGrid_Ys - CALL ReadVar ( UnIn, FileName, p%NLines, 'NLines', 'Number of Lines', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + IF (LEN_TRIM(inputString) == 0) THEN + ! If the input is empty (not provided), make the 1x1 bathymetry grid using the default depth + ALLOCATE(BathGrid(1,1), STAT=ErrStat4) + BathGrid(1,1) = DBLE(defaultDepth) + + ALLOCATE(BathGrid_Xs(1), STAT=ErrStat4) + BathGrid_Xs(1) = 0.0_DbKi + + ALLOCATE(BathGrid_Ys(1), STAT=ErrStat4) + BathGrid_Ys(1) = 0.0_DbKi + + ELSE IF (SCAN(inputString, "abcdfghijklmnopqrstuvwxyzABCDFGHIJKLMNOPQRSTUVWXYZ") == 0) THEN + ! If the input does not have any of these string values, let's treat it as a number but store in a matrix + ALLOCATE(BathGrid(1,1), STAT=ErrStat4) + READ(inputString, *, IOSTAT=ErrStat4) BathGrid(1,1) + + ALLOCATE(BathGrid_Xs(1), STAT=ErrStat4) + BathGrid_Xs(1) = 0.0_DbKi + + ALLOCATE(BathGrid_Ys(1), STAT=ErrStat4) + BathGrid_Ys(1) = 0.0_DbKi + ELSE ! otherwise interpret the input as a file name to load the bathymetry lookup data from + CALL WrScr(" The depth input contains letters so will load a bathymetry file.") + + ! load lookup table data from file + CALL GetNewUnit( UnCoef ) ! unit number for coefficient input file + CALL OpenFInpFile( UnCoef, TRIM(inputString), ErrStat4, ErrMsg4 ) + cALL SetErrStat(ErrStat4, ErrMsg4, ErrStat3, ErrMsg3, 'MDIO_getBathymetry') + + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! skip the first title line + READ(UnCoef,*,IOSTAT=ErrStat4) nGridX_string, nGridX ! read in the second line as the number of x values in the BathGrid + READ(UnCoef,*,IOSTAT=ErrStat4) nGridY_string, nGridY ! read in the third line as the number of y values in the BathGrid + + ! Allocate the bathymetry matrix and associated grid x and y values + ALLOCATE(BathGrid(nGridX, nGridY), STAT=ErrStat4) + ALLOCATE(BathGrid_Xs(nGridX), STAT=ErrStat4) + ALLOCATE(BathGrid_Ys(nGridY), STAT=ErrStat4) + + DO I = 1, nGridY+1 ! loop through each line in the rest of the bathymetry file + + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! read into a line and call it Line2 + IF (ErrStat4 > 0) EXIT + + IF (I==1) THEN ! if it's the first line in the Bathymetry Grid, then it's a list of all the x values + READ(Line2, *,IOSTAT=ErrStat4) BathGrid_Xs + ELSE ! if it's not the first line, then the first value is a y value and the rest are the depth values + READ(Line2, *,IOSTAT=ErrStat4) BathGrid_Ys(I-1), BathGrid(I-1,:) + ENDIF + + END DO - ! Table header - DO I = 1, 2 - CALL ReadCom( UnIn, FileName, 'Lines header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - END DO - - ! make sure NLines is at least one - IF ( p%NLines < 1 ) THEN - CALL SetErrStat( ErrID_Fatal, 'NLines parameter must be at least 1.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - ! allocate LineList - ALLOCATE ( m%LineList(p%NLines), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating space for LineList array.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - ! read each line - DO I = 1,p%NLines - ! read the table entries Line LineType UnstrLen NumSegs NodeAnch NodeFair Flags/Outputs - READ(UnIn,'(A)',IOSTAT=ErrStat2) Line !read into a line - - - IF (ErrStat2 == 0) THEN - READ(Line,*,IOSTAT=ErrStat2) m%LineList(I)%IdNum, m%LineList(I)%type, m%LineList(I)%UnstrLen, & - m%LineList(I)%N, m%LineList(I)%AnchConnect, m%LineList(I)%FairConnect, LineOutString, m%LineList(I)%CtrlChan - END IF - - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Failed to read line data for Line '//trim(Num2LStr(I)), ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - - ! check for sequential IdNums - IF ( m%LineList(I)%IdNum .NE. I ) THEN - CALL SetErrStat( ErrID_Fatal, 'Line numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - ! identify index of line type - DO J = 1,p%NTypes - IF (trim(m%LineList(I)%type) == trim(m%LineTypeList(J)%name)) THEN - m%LineList(I)%PropsIdNum = J - EXIT - IF (J == p%NTypes) THEN ! call an error if there is no match - CALL SetErrStat( ErrID_Severe, 'Unable to find matching line type name for Line '//trim(Num2LStr(I)), ErrStat, ErrMsg, RoutineName ) - END IF + IF (I < 2) THEN + ErrStat3 = ErrID_Fatal + ErrMsg3 = "Less than the minimum of 2 data lines found in file "//TRIM(inputString) + CLOSE (UnCoef) + RETURN + ELSE + ! BathGrid_npoints = nGridX*nGridY ! save the number of points in the grid + CLOSE (UnCoef) END IF - END DO - - ! process output flag characters (LineOutString) and set line output flag array (OutFlagList) - m%LineList(I)%OutFlagList = 0 ! first set array all to zero - IF ( scan( LineOutString, 'p') > 0 ) m%LineList(I)%OutFlagList(2) = 1 - IF ( scan( LineOutString, 'v') > 0 ) m%LineList(I)%OutFlagList(3) = 1 - IF ( scan( LineOutString, 'U') > 0 ) m%LineList(I)%OutFlagList(4) = 1 - IF ( scan( LineOutString, 'D') > 0 ) m%LineList(I)%OutFlagList(5) = 1 - IF ( scan( LineOutString, 't') > 0 ) m%LineList(I)%OutFlagList(6) = 1 - IF ( scan( LineOutString, 'c') > 0 ) m%LineList(I)%OutFlagList(7) = 1 - IF ( scan( LineOutString, 's') > 0 ) m%LineList(I)%OutFlagList(8) = 1 - IF ( scan( LineOutString, 'd') > 0 ) m%LineList(I)%OutFlagList(9) = 1 - IF ( scan( LineOutString, 'l') > 0 ) m%LineList(I)%OutFlagList(10)= 1 - IF (SUM(m%LineList(I)%OutFlagList) > 0) m%LineList(I)%OutFlagList(1) = 1 ! this first entry signals whether to create any output file at all - ! the above letter-index combinations define which OutFlagList entry corresponds to which output type - - - ! check errors - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read line data for Line '//trim(Num2LStr(I)) - CALL CleanUp() - RETURN - END IF - - - IF ( InitInp%Echo ) THEN - WRITE( UnEc, '(A)' ) TRIM(Line) - END IF - - END DO ! I - + + END IF - !------------------------------------------------------------------------------------------------- - ! Read any options lines - !------------------------------------------------------------------------------------------------- + END SUBROUTINE setupBathymetry + - CALL ReadCom( UnIn, FileName, 'Options header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + ! read in stiffness/damping coefficient or load nonlinear data file if applicable + SUBROUTINE getCoefficientOrCurve(inputString, LineProp_c, LineProp_npoints, LineProp_Xs, LineProp_Ys, ErrStat3, ErrMsg3) + + CHARACTER(40), INTENT(IN ) :: inputString + REAL(DbKi), INTENT(INOUT) :: LineProp_c + INTEGER(IntKi), INTENT( OUT) :: LineProp_nPoints + REAL(DbKi), INTENT( OUT) :: LineProp_Xs (nCoef) + REAL(DbKi), INTENT( OUT) :: LineProp_Ys (nCoef) + + INTEGER(IntKi), INTENT( OUT) :: ErrStat3 ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg3 ! Error message if ErrStat /= ErrID_None - ! loop through any remaining input lines, and use them to set options (overwriting default values in many cases). - ! doing this manually since I'm not sure that there is a built in subroutine for reading any input value on any line number. - DO - - READ(UnIn,'(A)',IOSTAT=ErrStat2) Line !read into a line - - IF (ErrStat2 == 0) THEN - IF (( Line(1:3) == '---' ) .OR. ( Line(1:3) == 'END' ) .OR. ( Line(1:3) == 'end' )) EXIT ! check if it's the end line - - READ(Line,*,IOSTAT=ErrStat2) OptValue, OptString ! look at first two entries, ignore remaining words in line, which should be comments - END IF - - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Failed to read options.', ErrStat, ErrMsg, RoutineName ) ! would be nice to specify which line had the error - CALL CleanUp() - RETURN - END IF - - CALL Conv2UC(OptString) - - ! check all possible options types and see if OptString is one of them, in which case set the variable. - if ( OptString == 'DTM') THEN - read (OptValue,*) p%dtM0 ! InitInp%DTmooring - else if ( OptString == 'G') then - read (OptValue,*) p%G - else if ( OptString == 'RHOW') then - read (OptValue,*) p%rhoW - else if ( OptString == 'WTRDPTH') then - read (OptValue,*) p%WtrDpth - else if ( OptString == 'KBOT') then - read (OptValue,*) p%kBot - else if ( OptString == 'CBOT') then - read (OptValue,*) p%cBot - else if ( OptString == 'DTIC') then - read (OptValue,*) InitInp%dtIC - else if ( OptString == 'TMAXIC') then - read (OptValue,*) InitInp%TMaxIC - else if ( OptString == 'CDSCALEIC') then - read (OptValue,*) InitInp%CdScaleIC - else if ( OptString == 'THRESHIC') then - read (OptValue,*) InitInp%threshIC - else - CALL SetErrStat( ErrID_Warn, 'unable to interpret input '//trim(OptString), ErrStat, ErrMsg, RoutineName ) - end if - - IF ( InitInp%Echo ) THEN - WRITE( UnEc, '(A)' ) TRIM(Line) - END IF - - END DO - - - !------------------------------------------------------------------------------------------------- - ! Read the FAST-style outputs list in the final section, if there is one - !------------------------------------------------------------------------------------------------- - ! we don't read in the outputs header line because it's already been read in for detecting the end of the variable-length options section - ! CALL ReadCom( UnIn, FileName, 'Outputs header', ErrStat, ErrMsg, UnEc ) - - ! allocate InitInp%Outliest (to a really big number for now...) - CALL AllocAry( InitInp%OutList, 1000, "MoorDyn Input File's Outlist", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() + INTEGER(IntKi) :: nC, I + INTEGER(IntKi) :: UnCoef ! unit number for coefficient input file + + + INTEGER(IntKi) :: ErrStat4 + CHARACTER(120) :: ErrMsg4 + CHARACTER(120) :: Line2 + + + if (SCAN(inputString, "abcdfghijklmnopqrstuvwxyzABCDFGHIJKLMNOPQRSTUVWXYZ") == 0) then ! "eE" are exluded as they're used for scientific notation! + + ! "found NO letter in the line coefficient value so treating it as a number." + READ(inputString, *, IOSTAT=ErrStat4) LineProp_c ! convert the entry string into a real number + 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.") + + LineProp_c = 0.0 + + ! load lookup table data from file + + CALL GetNewUnit( UnCoef ) + CALL OpenFInpFile( UnCoef, TRIM(inputString), ErrStat4, ErrMsg4 ) ! add error handling? + + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! skip the first two lines (title, names, and units) then parse + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 + + DO I = 1, nCoef + + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 !read into a line + + IF (ErrStat4 > 0) then + CALL WrScr("Error while reading lookup table file") + EXIT + ELSE IF (ErrStat4 < 0) then + CALL WrScr("Read "//trim(Int2LStr(I-1))//" data lines from lookup table file") + EXIT + ELSE + READ(Line2,*,IOSTAT=ErrStat4) LineProp_Xs(I), LineProp_Ys(I) + END IF + END DO + + if (I < 2) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = "Less than the minimum of 2 data lines found in file "//TRIM(inputString)//" (first 3 lines are headers)." + LineProp_npoints = 0 + Close (UnCoef) RETURN + else + LineProp_npoints = I-1 + Close (UnCoef) + end if + + END IF + + END SUBROUTINE getCoefficientOrCurve + + + ! Split a string into separate strings by the bar (|) symbol + SUBROUTINE SplitByBars(instring, n, outstrings) + + CHARACTER(*), INTENT(INOUT) :: instring + 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 + + n = 0 + pos1=1 + + DO + pos2 = INDEX(instring(pos1:), "|") ! find index of next comma + IF (pos2 == 0) THEN ! if there isn't another comma, read the last entry and call it done (this could be the only entry if no commas) + n = n + 1 + outstrings(n) = instring(pos1:) + EXIT END IF + n = n + 1 + if (n > 6) then + CALL WrScr("ERROR - SplitByBars cannot do more than 6 entries") + end if + outstrings(n) = instring(pos1:pos1+pos2-2) + pos1 = pos2+pos1 + END DO + + END SUBROUTINE SplitByBars - ! OutList - List of user-requested output channels (-): - CALL ReadOutputList ( UnIn, FileName, InitInp%OutList, p%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - !print *, 'NumOuts is ', p%NumOuts - !print *, ' OutList is ', InitInp%OutList(1:p%NumOuts) - - - !------------------------------------------------------------------------------------------------- - ! This is the end of the input file - !------------------------------------------------------------------------------------------------- - - CALL CleanUp() - CONTAINS - ! subroutine to set ErrState and close the files if an error occurs - SUBROUTINE CleanUp() - - ! ErrStat = ErrID_Fatal - CLOSE( UnIn ) - IF (InitInp%Echo) CLOSE( UnEc ) + ! Split a string into separate letter strings and integers. Letters are converted to uppercase. + SUBROUTINE DecomposeString(outWord, let1, num1, let2, num2, let3) + + CHARACTER(*), INTENT(INOUT) :: outWord + CHARACTER(25), INTENT( OUT) :: let1 + ! INTEGER(IntKi), INTENT( OUT) :: num1 + CHARACTER(25), INTENT( OUT) :: num1 + CHARACTER(25), INTENT( OUT) :: let2 + CHARACTER(25), INTENT( OUT) :: num2 +! INTEGER(IntKi), INTENT( OUT) :: num2 + CHARACTER(25), INTENT( OUT) :: let3 + + 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 + + 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 + INTEGER :: i4 = 0 - END SUBROUTINE + + CALL Conv2UC(outWord) ! convert to all uppercase for string matching purposes - END SUBROUTINE MDIO_ReadInput - ! ==================================================================================================== + ! start these strings as empty, and fill in only if used + let1 = '' + num1 = '' + let2 = '' + num2 = '' + let3 = '' + ! find indicies of changes in number-vs-letter in characters of outWord and split into segments accordingly + + i1 = scan( outWord , '1234567890' ) ! find index of first number in the string + if (i1 > 0) then ! if there is a number + let1 = TRIM(outWord( 1:i1-1)) + i2 = i1+verify( outWord(i1+1:) , '1234567890' ) ! find starting index of second set of letters (if first character is a letter, i.e. i1>1), otherwise index of first letter + if (i2 > i1) then ! if there is a second letter/word + num1 = TRIM(outWord(i1:i2-1)) + i3 = i2+scan( outWord(i2+1:) , '1234567890' ) ! find starting index of second set of numbers <<<< + if (i3 > i2) then ! if there is a second number + let2 = TRIM(outWord(i2:i3-1)) + i4 = i3+verify( outWord(i3+1:) , '1234567890' ) ! third letter start + if (i4 > i3) then ! if there is a third letter/word + num2 = TRIM(outWord(i3:i4-1)) + let3 = TRIM(outWord(i4: )) + else + num2 = TRIM(outWord(i3:)) + end if + else + let2 = TRIM(outWord(i2:)) + end if + else + num1 = TRIM(outWord(i1:)) + end if + else + let1 = TRIM(outWord) + end if + + + !READ(outWord(i1:i2-1)) num1 + !READ(outWord(i3:i4-1)) num2 + + ! print *, "Decomposed string ", outWord, " into:" + ! print *, let1 + ! print *, num1 + ! print *, let2 + ! print *, num2 + ! print *, let3 + ! print *, "based on indices (i1-i4):" + ! print *, i1 + ! print *, i2 + ! print *, i3 + ! print *, i4 + + END SUBROUTINE DecomposeString + ! ==================================================================================================== @@ -645,7 +418,16 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) INTEGER :: oID ! ID number of connect 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 - + + CHARACTER(25) :: let1 ! strings used for splitting and parsing identifiers + CHARACTER(25) :: num1 + CHARACTER(25) :: let2 + CHARACTER(25) :: num2 + CHARACTER(25) :: let3 + + INTEGER(IntKi) :: LineNumOuts ! number of entries in LineWrOutput for each line + INTEGER(IntKi) :: RodNumOuts ! same for Rods + ! see the top of the module for info on the output labelling types @@ -680,74 +462,114 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) DO I = 1,p%NumOuts OutListTmp = OutList(I) ! current requested output name + + call DecomposeString(OutListTmp, let1, num1, let2, num2, let3) + + + !p%OutParam(I)%Name = OutListTmp CALL Conv2UC(OutListTmp) ! convert to all uppercase for string matching purposes - ! find indicies of changes in number-vs-letter in characters of OutListTmp - i1 = scan( OutListTmp , '1234567890' ) ! first number in the string - i2 = i1+verify( OutListTmp(i1+1:) , '1234567890' ) ! second letter start (assuming first character is a letter, i.e. i1>1) - i3 = i2+scan( OutListTmp(i2+1:) , '1234567890' ) ! second number start - i4 = i3+verify( OutListTmp(i3+1:) , '1234567890' ) ! third letter start - !i5 = scan( OutListTmp(i1:) , '1234567890' ) ! find first letter after first number - + ! ! find indicies of changes in number-vs-letter in characters of OutListTmp + ! i1 = scan( OutListTmp , '1234567890' ) ! first number in the string + ! i2 = i1+verify( OutListTmp(i1+1:) , '1234567890' ) ! second letter start (assuming first character is a letter, i.e. i1>1) + ! i3 = i2+scan( OutListTmp(i2+1:) , '1234567890' ) ! second number start + ! i4 = i3+verify( OutListTmp(i3+1:) , '1234567890' ) ! third letter start + ! error check - IF (i1 <= 1) THEN - CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid - CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Starting character must be C or L.') - CYCLE ! <<<<<<<<<<< check correct usage - END IF + ! IF (i1 <= 1) THEN + ! CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + ! CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Starting character must be C or L.') + ! CYCLE ! <<<<<<<<<<< check correct usage + ! END IF p%OutParam(I)%Name = OutListTmp ! label channel with whatever name was inputted, for now ! figure out what type of output it is and process accordingly - ! fairlead tension case (updated) - IF (OutListTmp(1:i1-1) == 'FAIRTEN') THEN - p%OutParam(I)%OType = 2 ! connection object type + ! fairlead tension case (updated) <<<<<<<<<<<<<<<<<<<<<<<<<<< these are not currently working - need new way to find ObjID + IF (let1 == 'FAIRTEN') THEN + p%OutParam(I)%OType = 1 ! line object type p%OutParam(I)%QType = Ten ! tension quantity type p%OutParam(I)%Units = UnitList(Ten) ! set units according to QType - READ (OutListTmp(i1:),*) oID ! this is the line number - p%OutParam(I)%ObjID = m%LineList(oID)%FairConnect ! get the connection ID of the fairlead - p%OutParam(I)%NodeID = -1 ! not used. m%LineList(oID)%N ! specify node N (fairlead) - + READ (num1,*) oID ! this is the line number + p%OutParam(I)%ObjID = oID ! record the ID of the line + p%OutParam(I)%NodeID = m%LineList(oID)%N ! specify node N (end B, fairlead) + ! >>> should check validity of ObjID and NodeID <<< + ! achor tension case - ELSE IF (OutListTmp(1:i1-1) == 'ANCHTEN') THEN - p%OutParam(I)%OType = 2 ! connectoin object type + ELSE IF (let1 == 'ANCHTEN') THEN + p%OutParam(I)%OType = 1 ! line object type p%OutParam(I)%QType = Ten ! tension quantity type p%OutParam(I)%Units = UnitList(Ten) ! set units according to QType - READ (OutListTmp(i1:),*) oID ! this is the line number - p%OutParam(I)%ObjID = m%LineList(oID)%AnchConnect ! get the connection ID of the fairlead - p%OutParam(I)%NodeID = -1 ! not used. m%LineList(oID)%0 ! specify node 0 (anchor) + READ (num1,*) oID ! this is the line number + p%OutParam(I)%ObjID = oID ! record the ID of the line + p%OutParam(I)%NodeID = 0 ! specify node 0 (end A, anchor) ! more general case ELSE ! what object type? - ! Line case ... L?N?xxxx - IF (OutListTmp(1:i1-1) == 'L') THEN + + ! Line case + IF (let1(1:1) == 'L') THEN ! Look for L?N?xxxx p%OutParam(I)%OType = 1 ! Line object type - ! for now we'll just assume the next character(s) are "n" to represent node number: - READ (OutListTmp(i3:i4-1),*) nID - p%OutParam(I)%NodeID = nID - qVal = OutListTmp(i4:) ! isolate quantity type string - ! Connect case ... C?xxx or Con?xxx - ELSE IF (OutListTmp(1:1) == 'C') THEN + ! for now we'll just assume the next character(s) are "n" to represent node number or "s" to represent segment number + IF (num2/=" ") THEN + READ (num2,*) nID ! node or segment ID + p%OutParam(I)%NodeID = nID + ELSE + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Line ID or Node ID missing.') + CYCLE + END IF + qVal = let3 ! quantity type string + + ! Connect case + ELSE IF (let1(1:1) == 'C') THEN ! Look for C?xxx or Con?xxx p%OutParam(I)%OType = 2 ! Connect object type - qVal = OutListTmp(i2:) ! isolate quantity type string + qVal = let2 ! quantity type string + + ! Rod case + ELSE IF (let1(1:1) == 'R') THEN ! Look for R?xxx or Rod?xxx + p%OutParam(I)%OType = 3 ! Rod object type + IF (LEN_TRIM(let3)== 0) THEN ! No third character cluster indicates this is a whole-rod channel + p%OutParam(I)%NodeID = 0 + qVal = let2 ! quantity type string + ELSE IF (num2/=" ") THEN + READ (num2,*) nID ! rod node ID + p%OutParam(I)%NodeID = nID + qVal = let3 ! quantity type string + ELSE + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Rod ID or Node ID missing.') + CYCLE + END IF + + ! Body case + ELSE IF (Let1(1:1) == 'B') THEN ! Look for B?xxx or Body?xxx + p%OutParam(I)%OType = 4 ! Body object type + qVal = let2 ! quantity type string ! should do fairlead option also! ! error ELSE CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid - CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Type must be L or C.') + CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Must start with L, C, R, or B') CYCLE END IF ! object number - READ (OutListTmp(i1:i2-1),*) oID - p%OutParam(I)%ObjID = oID ! line or connect ID number + IF (num1/=" ") THEN + READ (num1,*) oID + p%OutParam(I)%ObjID = oID ! line or connect ID number + ELSE + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Object ID missing.') + CYCLE + END IF ! which kind of quantity? IF (qVal == 'PX') THEN @@ -777,7 +599,7 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) ELSE IF (qVal == 'AZ') THEN p%OutParam(I)%QType = AccZ p%OutParam(I)%Units = UnitList(AccZ) - ELSE IF ((qVal == 'T') .or. (qval == 'Ten')) THEN + ELSE IF ((qVal == 'T') .or. (qVal == 'TEN')) THEN p%OutParam(I)%QType = Ten p%OutParam(I)%Units = UnitList(Ten) ELSE IF (qVal == 'FX') THEN @@ -788,7 +610,19 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) p%OutParam(I)%Units = UnitList(FY) ELSE IF (qVal == 'FZ') THEN p%OutParam(I)%QType = FZ - p%OutParam(I)%Units = UnitList(FZ) + p%OutParam(I)%Units = UnitList(FZ) ! <<<< should add moments as well <<<< + ELSE IF (qVal == 'ROLL') THEN + p%OutParam(I)%QType = Roll + p%OutParam(I)%Units = UnitList(Roll) + ELSE IF (qVal == 'PITCH') THEN + p%OutParam(I)%QType = Pitch + p%OutParam(I)%Units = UnitList(Pitch) + ELSE IF (qVal == 'YAW') THEN + p%OutParam(I)%QType = Yaw + p%OutParam(I)%Units = UnitList(Yaw) + ELSE IF (qVal == 'SUB') THEN + p%OutParam(I)%QType = Sub + p%OutParam(I)%Units = UnitList(Sub) ELSE CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Quantity type not recognized.') @@ -798,23 +632,44 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) END IF ! also check whether each object index and node index (if applicable) is in range - IF (p%OutParam(I)%OType==2) THEN + + IF (p%OutParam(I)%OType==1) THEN ! Line + IF (p%OutParam(I)%ObjID > p%NLines) THEN + CALL WrScr('Warning: output Line index excedes number of Lines in requested output '//trim(OutListTmp)//'.') + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + END IF + IF (p%OutParam(I)%NodeID > m%LineList(p%OutParam(I)%ObjID)%N) THEN + CALL WrScr('Warning: output node index excedes number of nodes in requested output '//trim(OutListTmp)//'.') + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + ELSE IF (p%OutParam(I)%NodeID < 0) THEN + CALL WrScr('Warning: output node index is less than zero in requested output '//trim(OutListTmp)//'.') + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + END IF + + ELSE IF (p%OutParam(I)%OType==2) THEN ! Connect IF (p%OutParam(I)%ObjID > p%NConnects) THEN CALL WrScr('Warning: output Connect index excedes number of Connects in requested output '//trim(OutListTmp)//'.') CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid END IF - ELSE IF (p%OutParam(I)%OType==1) THEN - IF (p%OutParam(I)%ObjID > p%NLines) THEN - CALL WrScr('Warning: output Line index excedes number of Lines in requested output '//trim(OutListTmp)//'.') + + ELSE IF (p%OutParam(I)%OType==3) THEN ! Rod + IF (p%OutParam(I)%ObjID > p%NRods) THEN + CALL WrScr('Warning: output Rod index excedes number of Rods in requested output '//trim(OutListTmp)//'.') CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid END IF - IF (p%OutParam(I)%NodeID > m%LineList(p%OutParam(I)%ObjID)%N) THEN + IF (p%OutParam(I)%NodeID > m%RodList(p%OutParam(I)%ObjID)%N) THEN CALL WrScr('Warning: output node index excedes number of nodes in requested output '//trim(OutListTmp)//'.') CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid ELSE IF (p%OutParam(I)%NodeID < 0) THEN CALL WrScr('Warning: output node index is less than zero in requested output '//trim(OutListTmp)//'.') CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid END IF + + ELSE IF (p%OutParam(I)%OType==4) THEN ! Body + IF (p%OutParam(I)%ObjID > p%NBodies) THEN + CALL WrScr('Warning: output Body index excedes number of Bodies in requested output '//trim(OutListTmp)//'.') + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + END IF END IF @@ -855,13 +710,36 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) ! allocate output array in each Line DO I=1,p%NLines - ALLOCATE(m%LineList(I)%LineWrOutput( 1 + 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:5)) + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(6:10)) ), STAT = ErrStat) + + + ! calculate number of output entries (excluding time) to write for this line + LineNumOuts = 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:6)) & + + (m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(7:9)) & + + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(10:18)) + + ALLOCATE(m%LineList(I)%LineWrOutput( 1 + LineNumOuts), STAT = ErrStat) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating space for a LineWrOutput array' ErrStat = ErrID_Fatal RETURN END IF END DO ! I + + ! allocate output array in each Rod + DO I=1,p%NRods + + ! calculate number of output entries (excluding time) to write for this Rod + RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:9)) & + + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(10:11)) & + + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(12:18)) + + ALLOCATE(m%RodList(I)%RodWrOutput( 1 + RodNumOuts), STAT = ErrStat) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating space for a RodWrOutput array' + ErrStat = ErrID_Fatal + RETURN + END IF + END DO ! I !print *, "y%WriteOutput allocated to size ", size(y%WriteOutput) @@ -888,17 +766,16 @@ SUBROUTINE DenoteInvalidOutput( OutParm ) END SUBROUTINE DenoteInvalidOutput END SUBROUTINE MDIO_ProcessOutList - !==================================================================================================== + !----------------------------------------------------------------------------------------============ - !==================================================================================================== - SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) + !----------------------------------------------------------------------------------------============ + SUBROUTINE MDIO_OpenOutput( p, m, InitOut, ErrStat, ErrMsg ) !---------------------------------------------------------------------------------------------------- - CHARACTER(*), INTENT( IN ) :: OutRootName ! Root name for the output file TYPE(MD_ParameterType), INTENT( INOUT ) :: p TYPE(MD_MiscVarType), INTENT( INOUT ) :: m TYPE(MD_InitOutPutType ), INTENT( IN ) :: InitOut ! @@ -908,8 +785,9 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, 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 :: LineNumOuts ! number of entries in LineWrOutput for each line + 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 INTEGER :: ErrStat2 @@ -917,7 +795,7 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - p%Delim = ' ' ! for now + p%Delim = ' ' ! for now !------------------------------------------------------------------------------------------------- ! Open the output file, if necessary, and write the header @@ -939,7 +817,7 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) !Write the names of the output parameters: - Frmt = '(A10,'//TRIM(Int2LStr(p%NumOuts))//'(A1,A10))' + Frmt = '(A10,'//TRIM(Int2LStr(p%NumOuts))//'(A1,A12))' WRITE(p%MDUnOut,Frmt, IOSTAT=ErrStat2) TRIM( 'Time' ), ( p%Delim, TRIM( p%OutParam(I)%Name), I=1,p%NumOuts ) @@ -975,90 +853,123 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) END IF - ! calculate number of output entries (including time) to write for this line - LineNumOuts = 1 + 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:5)) + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(6:10)) - - Frmt = '(A10,'//TRIM(Int2LStr(LineNumOuts))//'(A1,A10))' ! should evenutally use user specified format? - !Frmt = '(A10,'//TRIM(Int2LStr(3+3*m%LineList(I)%N))//'(A1,A10))' + ! calculate number of output entries (excluding time) to write for this line + LineNumOuts = 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:6)) & + + (m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(7:9)) & + + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(10:18)) + + if (wordy > 2) PRINT *, LineNumOuts, " output channels" + + Frmt = '(A10,'//TRIM(Int2LStr(1 + LineNumOuts))//'(A1,A12))' ! should evenutally use user specified format? + !Frmt = '(A10,'//TRIM(Int2LStr(3+3*m%LineList(I)%N))//'(A1,A12))' ! Write the names of the output parameters: (these use "implied DO" loops) WRITE(m%LineList(I)%LineUnOut,'(A10)', advance='no', IOSTAT=ErrStat2) TRIM( 'Time' ) IF (m%LineList(I)%OutFlagList(2) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'px', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'py', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'pz', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(3) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vz', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(4) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Ux', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Uy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Uz', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(5) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dz', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(6) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & - ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Ten', J=1,(m%LineList(I)%N) ) + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'bx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'by', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'bz', J=0,(m%LineList(I)%N) ) END IF + IF (m%LineList(I)%OutFlagList(7) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & - ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Dmp', J=1,(m%LineList(I)%N) ) + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Wz', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(8) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Kurv', J=0,(m%LineList(I)%N) ) + END IF + + IF (m%LineList(I)%OutFlagList(10) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Ten', J=1,(m%LineList(I)%N) ) + END IF + IF (m%LineList(I)%OutFlagList(11) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Dmp', J=1,(m%LineList(I)%N) ) + END IF + IF (m%LineList(I)%OutFlagList(12) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Str', J=1,(m%LineList(I)%N) ) END IF - IF (m%LineList(I)%OutFlagList(9) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + IF (m%LineList(I)%OutFlagList(13) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'SRt', J=1,(m%LineList(I)%N) ) END IF - IF (m%LineList(I)%OutFlagList(10)== 1) THEN + IF (m%LineList(I)%OutFlagList(14)== 1) THEN WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Lst', J=1,(m%LineList(I)%N) ) END IF WRITE(m%LineList(I)%LineUnOut,'(A1)', IOSTAT=ErrStat2) ' ' ! make line break at the end + ! Now write the units line WRITE(m%LineList(I)%LineUnOut,'(A10)', advance='no', IOSTAT=ErrStat2) TRIM( '(s)' ) IF (m%LineList(I)%OutFlagList(2) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(m)', p%Delim, '(m)', p%Delim, '(m)', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(3) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(m/s)', p%Delim, '(m/s)', p%Delim, '(m/s)', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(4) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(m/s)', p%Delim, '(m/s)', p%Delim, '(m/s)', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(5) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(6) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & - ( p%Delim, '(N)', J=1,(m%LineList(I)%N) ) + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%LineList(I)%N) ) END IF + IF (m%LineList(I)%OutFlagList(7) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & - ( p%Delim, '(N)', J=1,(m%LineList(I)%N) ) + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(Nup)', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(8) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(1/m)', J=0,(m%LineList(I)%N) ) + END IF + + IF (m%LineList(I)%OutFlagList(10) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', J=1,(m%LineList(I)%N) ) + END IF + IF (m%LineList(I)%OutFlagList(11) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', J=1,(m%LineList(I)%N) ) + END IF + IF (m%LineList(I)%OutFlagList(12) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(-)', J=1,(m%LineList(I)%N) ) END IF - IF (m%LineList(I)%OutFlagList(9) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + IF (m%LineList(I)%OutFlagList(13) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(1/s)', J=1,(m%LineList(I)%N) ) END IF - IF (m%LineList(I)%OutFlagList(10)== 1) THEN + IF (m%LineList(I)%OutFlagList(14)== 1) THEN WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(m)', J=1,(m%LineList(I)%N) ) END IF @@ -1070,13 +981,185 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) END DO ! I - line number + + + !-------------------------------------------------------------------------- + ! now do the same for rod output files + !-------------------------------------------------------------------------- + + !! allocate UnLineOuts + !ALLOCATE(UnLineOuts(p%NLines)) ! should add error checking + + DO I = 1,p%NRods + + + IF (m%RodList(I)%OutFlagList(1) == 1) THEN ! only proceed if the Rod is flagged to output a file + + ! Open the file for output + OutFileName = TRIM(p%RootName)//'.Rod'//TRIM(Int2LStr(I))//'.out' + CALL GetNewUnit( m%RodList(I)%RodUnOut ) + + CALL OpenFOutFile ( m%RodList(I)%RodUnOut, OutFileName, ErrStat, ErrMsg ) + IF ( ErrStat > ErrID_None ) THEN + ErrMsg = ' Error opening Rod output file '//TRIM(ErrMsg) + ErrStat = ErrID_Fatal + RETURN + END IF + + + ! calculate number of output entries (excluding time) to write for this Rod + RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:9)) & + + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(10:11)) & + + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(12:18)) + + if (wordy > 2) PRINT *, RodNumOuts, " output channels" + + Frmt = '(A10,'//TRIM(Int2LStr(1 + RodNumOuts))//'(A1,A12))' ! should evenutally use user specified format? + !Frmt = '(A10,'//TRIM(Int2LStr(3+3*m%RodList(I)%N))//'(A1,A12))' + + ! >>> should functionalize the below <<< + + + ! Write the names of the output parameters: (these use "implied DO" loops) + + WRITE(m%RodList(I)%RodUnOut,'(A10)', advance='no', IOSTAT=ErrStat2) TRIM( 'Time' ) + IF (m%RodList(I)%OutFlagList(2) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'px', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'py', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'pz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(3) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(4) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Ux', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Uy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Uz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(5) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Box', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Boy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Boz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(6) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(7) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Fix', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Fiy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Fiz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(8) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Pdx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Pdy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Pdz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(9) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'bx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'by', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'bz', J=0,(m%RodList(I)%N) ) + END IF + + IF (m%RodList(I)%OutFlagList(10) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Wz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(11) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Kurv', J=0,(m%RodList(I)%N) ) + END IF + + IF (m%RodList(I)%OutFlagList(12) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Ten', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(13) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Dmp', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(14) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Str', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(15) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'SRt', J=1,(m%RodList(I)%N) ) + END IF + + WRITE(m%RodList(I)%RodUnOut,'(A1)', IOSTAT=ErrStat2) ' ' ! make line break at the end + + + ! Now write the units line + + WRITE(m%RodList(I)%RodUnOut,'(A10)', advance='no', IOSTAT=ErrStat2) TRIM( '(s)' ) + IF (m%RodList(I)%OutFlagList(2) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(m)', p%Delim, '(m)', p%Delim, '(m)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(3) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(m/s)', p%Delim, '(m/s)', p%Delim, '(m/s)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(4) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(m/s)', p%Delim, '(m/s)', p%Delim, '(m/s)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(5) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(6) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(7) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(8) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(9) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%RodList(I)%N) ) + END IF + + IF (m%RodList(I)%OutFlagList(10) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(Nup)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(11) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(1/m)', J=0,(m%RodList(I)%N) ) + END IF + + IF (m%RodList(I)%OutFlagList(12) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(13) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(14) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(-)', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(15) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(1/s)', J=1,(m%RodList(I)%N) ) + END IF + + WRITE(m%RodList(I)%RodUnOut,'(A1)', IOSTAT=ErrStat2) ' ' ! make Rod break at the end + + END IF ! if rod is flagged for output file + + END DO ! I - rod number + ! need to fix error handling in this sub END SUBROUTINE MDIO_OpenOutput - !==================================================================================================== + !----------------------------------------------------------------------------------------============ - !==================================================================================================== + !----------------------------------------------------------------------------------------============ SUBROUTINE MDIO_CloseOutput ( p, m, ErrStat, ErrMsg ) ! This function cleans up after running the MoorDyn output module. ! It closes the output files and releases memory. @@ -1093,26 +1176,41 @@ SUBROUTINE MDIO_CloseOutput ( p, m, ErrStat, ErrMsg ) ErrMsg = "" +!FIXME: make sure thes are actually open before trying to close them. Segfault will occur otherwise!!!! +! This bug can be triggered by an early failure of the parsing routines, before these files were ever opened +! which returns MD to OpenFAST as ErrID_Fatal, then OpenFAST calls MD_End, which calls this. + ! close main MoorDyn output file if (p%MDUnOut > 0) then CLOSE( p%MDUnOut, IOSTAT = ErrStat ) - IF ( ErrStat /= 0 ) THEN - ErrMsg = 'Error closing output file' - END IF - endif - + IF ( ErrStat /= 0 ) THEN + ErrMsg = 'Error closing output file' + END IF + end if + + ! close individual rod output files + DO I=1,p%NRods + if (allocated(m%RodList)) then + if (m%RodList(I)%RodUnOut > 0) then + CLOSE( m%RodList(I)%RodUnOut, IOSTAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrMsg = 'Error closing rod output file' + END IF + end if + end if + END DO + ! close individual line output files - if (allocated(m%LineList)) then - DO I=1,p%NLines + DO I=1,p%NLines + if (allocated(m%LineList)) then if (m%LineList(I)%LineUnOut > 0) then CLOSE( m%LineList(I)%LineUnOut, IOSTAT = ErrStat ) - IF ( ErrStat /= 0 ) THEN - ErrMsg = 'Error closing line output file' - exit ! exit this loop - END IF - endif - END DO - endif + IF ( ErrStat /= 0 ) THEN + ErrMsg = 'Error closing line output file' + END IF + end if + end if + END DO ! deallocate output arrays IF (ALLOCATED(m%MDWrOutput)) THEN @@ -1125,10 +1223,10 @@ SUBROUTINE MDIO_CloseOutput ( p, m, ErrStat, ErrMsg ) END DO END SUBROUTINE MDIO_CloseOutput - !==================================================================================================== + !----------------------------------------------------------------------------------------============ - !==================================================================================================== + !----------------------------------------------------------------------------------------============ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) ! This subroutine gathers the output data defined by the OutParams list and ! writes it to the output file opened in MDIO_OutInit() @@ -1145,6 +1243,7 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) INTEGER :: K ! Generic loop counter INTEGER :: L ! counter for index in LineWrOutput INTEGER :: LineNumOuts ! number of entries in LineWrOutput for each line + INTEGER :: RodNumOuts ! same for Rods CHARACTER(200) :: Frmt ! a string to hold a format statement @@ -1156,80 +1255,177 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = '' END IF + + ! -------------------------------- main output file -------------------------------- + + if ( p%NumOuts > 0_IntKi ) then + + ! gather the required output quantities (INCOMPLETE!) + DO I = 1,p%NumOuts + + + IF (p%OutParam(I)%OType == 1) THEN ! if dealing with a Line output + + SELECT CASE (p%OutParam(I)%QType) + CASE (PosX) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(1,p%OutParam(I)%NodeID) ! x position + CASE (PosY) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(2,p%OutParam(I)%NodeID) ! y position + CASE (PosZ) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(3,p%OutParam(I)%NodeID) ! z position + CASE (VelX) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(1,p%OutParam(I)%NodeID) ! x velocity + CASE (VelY) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(2,p%OutParam(I)%NodeID) ! y velocity + CASE (VelZ) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(3,p%OutParam(I)%NodeID) ! z velocity + 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! + + CASE DEFAULT + y%WriteOutput(I) = 0.0_ReKi + ErrStat = ErrID_Warn + ErrMsg = ' Unsupported output quantity '//TRIM(p%OutParam(I)%Name)//' requested from Line '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' + END SELECT + + ELSE IF (p%OutParam(I)%OType == 2) THEN ! if dealing with a Connect output + SELECT CASE (p%OutParam(I)%QType) + CASE (PosX) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(1) ! x position + CASE (PosY) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(2) ! y position + CASE (PosZ) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(3) ! z position + CASE (VelX) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(1) ! x velocity + CASE (VelY) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(2) ! y velocity + CASE (VelZ) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(3) ! z velocity + CASE (AccX) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%a(1) ! x acceleration + CASE (AccY) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%a(2) ! y acceleration + CASE (AccZ) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%a(3) ! z acceleration + CASE (Ten) + y%WriteOutput(I) = TwoNorm(m%ConnectList(p%OutParam(I)%ObjID)%Fnet) ! total force magnitude on a connect (used eg. for fairlead and anchor tensions) + CASE (FX) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Fnet(1) ! total force in x - added Nov 24 + CASE (FY) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Fnet(2) ! total force in y + CASE (FZ) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Fnet(3) ! total force in z + CASE DEFAULT + y%WriteOutput(I) = 0.0_ReKi + ErrStat = ErrID_Warn + ErrMsg = ' Unsupported output quantity '//TRIM(p%OutParam(I)%Name)//' requested from Connection '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' + END SELECT + + ELSE IF (p%OutParam(I)%OType == 3) THEN ! if dealing with a Rod output + + SELECT CASE (p%OutParam(I)%QType) + CASE (PosX) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%r(1,p%OutParam(I)%NodeID) ! x position + CASE (PosY) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%r(2,p%OutParam(I)%NodeID) ! y position + CASE (PosZ) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%r(3,p%OutParam(I)%NodeID) ! z position + CASE (VelX) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%rd(1,p%OutParam(I)%NodeID) ! x velocity + CASE (VelY) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%rd(2,p%OutParam(I)%NodeID) ! y velocity + CASE (VelZ) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%rd(3,p%OutParam(I)%NodeID) ! z velocity + CASE (AccX) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%a6(1) ! x acceleration <<< should this become distributed for each node? + CASE (AccY) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%a6(2) ! y acceleration + CASE (AccZ) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%a6(3) ! z acceleration + CASE (FX) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%F6net(1) ! total force in x - added Nov 24 + CASE (FY) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%F6net(2) ! total force in y + CASE (FZ) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%F6net(3) ! total force in z + CASE (Roll) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%roll*180.0/pi ! rod roll + CASE (Pitch) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%pitch*180.0/pi ! rod pitch + CASE (Sub) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%h0 / m%RodList(p%OutParam(I)%ObjID)%UnstrLen ! rod submergence + CASE DEFAULT + y%WriteOutput(I) = 0.0_ReKi + ErrStat = ErrID_Warn + ErrMsg = ' Unsupported output quantity '//TRIM(p%OutParam(I)%Name)//' requested from Rod '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' + END SELECT + + ELSE IF (p%OutParam(I)%OType == 4) THEN ! if dealing with a Body output + SELECT CASE (p%OutParam(I)%QType) + CASE (PosX) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(1) ! x position + CASE (PosY) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(2) ! y position + CASE (PosZ) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(3) ! z position + CASE (VelX) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%v6(1) ! x velocity + CASE (VelY) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%v6(2) ! y velocity + CASE (VelZ) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%v6(3) ! z velocity + CASE (FX) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%F6net(1) ! total force in x - added Nov 24 + CASE (FY) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%F6net(2) ! total force in y + CASE (FZ) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%F6net(3) ! total force in z + CASE (Roll) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(4)*180.0/pi ! roll + CASE (Pitch) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(5)*180.0/pi ! pitch + CASE (Yaw) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(6)*180.0/pi ! yaw + CASE DEFAULT + y%WriteOutput(I) = 0.0_ReKi + ErrStat = ErrID_Warn + ErrMsg = ' Unsupported output quantity '//TRIM(p%OutParam(I)%Name)//' requested from Body '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' + END SELECT + + + ELSE ! it must be an invalid output, so write zero + y%WriteOutput(I) = 0.0_ReKi - ! Return if there are no outputs - if ( p%NumOuts < 1_IntKi ) return - - - ! gather the required output quantities (INCOMPLETE!) - DO I = 1,p%NumOuts - - IF (p%OutParam(I)%OType == 2) THEN ! if dealing with a Connect output - SELECT CASE (p%OutParam(I)%QType) - CASE (PosX) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(1) ! x position - CASE (PosY) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(2) ! y position - CASE (PosZ) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(3) ! z position - CASE (VelX) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(1) ! x velocity - CASE (VelY) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(2) ! y velocity - CASE (VelZ) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(3) ! z velocity - CASE (Ten) - y%WriteOutput(I) = TwoNorm(m%ConnectList(p%OutParam(I)%ObjID)%Ftot) ! total force magnitude on a connect (used eg. for fairlead and anchor tensions) - CASE (FX) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Ftot(1) ! total force in x - added Nov 24 - CASE (FY) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Ftot(2) ! total force in y - CASE (FZ) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Ftot(3) ! total force in z - CASE DEFAULT - y%WriteOutput(I) = 0.0_DbKi - ErrStat = ErrID_Warn - ErrMsg = ' Unsupported output quantity '//TRIM(Num2Lstr(p%OutParam(I)%QType))//' requested from Connection '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' - END SELECT - - ELSE IF (p%OutParam(I)%OType == 1) THEN ! if dealing with a Line output - - SELECT CASE (p%OutParam(I)%QType) - CASE (PosX) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(1,p%OutParam(I)%NodeID) ! x position - CASE (PosY) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(2,p%OutParam(I)%NodeID) ! y position - CASE (PosZ) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(3,p%OutParam(I)%NodeID) ! z position - CASE (VelX) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(1,p%OutParam(I)%NodeID) ! x velocity - CASE (VelY) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(2,p%OutParam(I)%NodeID) ! y velocity - CASE (VelZ) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(3,p%OutParam(I)%NodeID) ! z velocity - CASE (Ten) - y%WriteOutput(I) = TwoNorm(m%LineList(p%OutParam(I)%ObjID)%T(:,p%OutParam(I)%NodeID)) ! this is actually the segment tension ( 1 < NodeID < N ) Should deal with properly! - CASE DEFAULT - y%WriteOutput(I) = 0.0_DbKi - ErrStat = ErrID_Warn - ErrMsg = ' Unsupported output quantity '//TRIM(Num2Lstr(p%OutParam(I)%QType))//' requested from Line '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' - END SELECT - - ELSE ! it must be an invalid output, so write zero - y%WriteOutput(I) = 0.0_DbKi - - END IF - - END DO ! I, loop through OutParam - - - ! Write the output parameters to the file - - Frmt = '(F10.4,'//TRIM(Int2LStr(p%NumOuts))//'(A1,e12.6))' ! should evenutally use user specified format? + END IF - WRITE(p%MDUnOut,Frmt) Time, ( p%Delim, y%WriteOutput(I), I=1,p%NumOuts ) + END DO ! I, loop through OutParam + END IF + ! check if this is a repeated time step, in which case exit instead of writing a duplicate line to the output files + if (Time <= m%LastOutTime) then + return + else + m%LastOutTime = Time + end if + + ! if using a certain output time step, check whether we should output, and exit the subroutine if not + if (p%dtOut > 0) then + !if (Time < (floor((Time-p%dtCoupling)/p%dtOut) + 1.0)*p%dtOut) then + if ( abs(MOD( Time - 0.5*p%dtOut, p%dtOut) - 0.5*p%dtOut) >= 0.5*p%dtCoupling) then + return + end if + end if + ! What the above does is say if ((dtOut==0) || (t >= (floor((t-dtC)/dtOut) + 1.0)*dtOut)), continue to writing files + + if ( p%NumOuts > 0_IntKi ) then + + ! Write the output parameters to the file + Frmt = '(F10.4,'//TRIM(Int2LStr(p%NumOuts))//'(A1,e12.5))' ! should evenutally use user specified format? + + WRITE(p%MDUnOut,Frmt) Time, ( p%Delim, y%WriteOutput(I), I=1,p%NumOuts ) + END IF @@ -1241,12 +1437,19 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) IF (m%LineList(I)%OutFlagList(1) == 1) THEN ! only proceed if the line is flagged to output a file ! calculate number of output entries to write for this line - LineNumOuts = 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:5)) + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(6:10)) + !LineNumOuts = 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:5)) + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(6:9)) + LineNumOuts = 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:6)) & + + (m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(7:9)) & + + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(10:18)) - Frmt = '(F10.4,'//TRIM(Int2LStr(LineNumOuts))//'(A1,e12.6))' ! should evenutally use user specified format? - - L = 1 ! start of index of line output file at first entry + if (m%LineList(I)%OutFlagList(2) == 1) THEN ! if node positions are included, make them using a float format for higher precision + Frmt = '(F10.4,'//TRIM(Int2LStr(3*(m%LineList(I)%N + 1)))//'(A1,F12.4),'//TRIM(Int2LStr(LineNumOuts - 3*(m%LineList(I)%N - 1)))//'(A1,e12.5))' + else + Frmt = '(F10.4,'//TRIM(Int2LStr(LineNumOuts))//'(A1,e12.5))' ! should evenutally use user specified format? + end if + + L = 1 ! start of index of line output file at first entry 12345.7890 ! Time ! m%LineList(I)%LineWrOutput(L) = Time @@ -1277,7 +1480,7 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) IF (m%LineList(I)%OutFlagList(4) == 1) THEN DO J = 0,m%LineList(I)%N ! note index starts at zero because these are nodes DO K = 1,3 - m%LineList(I)%LineWrOutput(L) = 0.0 + m%LineList(I)%LineWrOutput(L) = m%LineList(I)%U(K,J) L = L+1 END DO END DO @@ -1295,8 +1498,36 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF - ! Segment tension force (excludes damping term, just EA) + ! Node seabed contact force IF (m%LineList(I)%OutFlagList(6) == 1) THEN + DO J = 0,m%LineList(I)%N + DO K = 1,3 + m%LineList(I)%LineWrOutput(L) = m%LineList(I)%B(K,J) + L = L+1 + END DO + END DO + END IF + + + ! Node weights + IF (m%LineList(I)%OutFlagList(7) == 1) THEN + DO J = 0,m%LineList(I)%N + m%LineList(I)%LineWrOutput(L) = m%LineList(I)%W(3,J) + L = L+1 + END DO + END IF + + ! ! Node curvatures + ! IF (m%LineList(I)%OutFlagList(8) == 1) THEN + ! DO J = 0,m%LineList(I)%N + ! m%LineList(I)%LineWrOutput(L) = m%LineList(I)%W(3,J) + ! L = L+1 + ! END DO + ! END IF + + + ! Segment tension force (excludes damping term, just EA) + IF (m%LineList(I)%OutFlagList(10) == 1) THEN DO J = 1,m%LineList(I)%N m%LineList(I)%LineWrOutput(L) = TwoNorm(m%LineList(I)%T(:,J) ) L = L+1 @@ -1304,7 +1535,7 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF ! Segment internal damping force - IF (m%LineList(I)%OutFlagList(7) == 1) THEN + IF (m%LineList(I)%OutFlagList(11) == 1) THEN DO J = 1,m%LineList(I)%N IF (( m%LineList(I)%Td(3,J)*m%LineList(I)%T(3,J) ) > 0) THEN ! if statement for handling sign (positive = tension) m%LineList(I)%LineWrOutput(L) = TwoNorm(m%LineList(I)%Td(:,J) ) @@ -1316,7 +1547,7 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF ! Segment strain - IF (m%LineList(I)%OutFlagList(8) == 1) THEN + IF (m%LineList(I)%OutFlagList(12) == 1) THEN DO J = 1,m%LineList(I)%N m%LineList(I)%LineWrOutput(L) = m%LineList(I)%lstr(J)/m%LineList(I)%l(J) - 1.0 L = L+1 @@ -1324,7 +1555,7 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF ! Segment strain rate - IF (m%LineList(I)%OutFlagList(9) == 1) THEN + IF (m%LineList(I)%OutFlagList(13) == 1) THEN DO J = 1,m%LineList(I)%N m%LineList(I)%LineWrOutput(L) = m%LineList(I)%lstrd(J)/m%LineList(I)%l(J) L = L+1 @@ -1332,13 +1563,14 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF ! Segment length - IF (m%LineList(I)%OutFlagList(10) == 1) THEN + IF (m%LineList(I)%OutFlagList(14) == 1) THEN DO J = 1,m%LineList(I)%N m%LineList(I)%LineWrOutput(L) = m%LineList(I)%lstr(J) L = L+1 END DO END IF + WRITE(m%LineList(I)%LineUnOut,Frmt) Time, ( p%Delim, m%LineList(I)%LineWrOutput(J), J=1,(LineNumOuts) ) !WRITE(m%LineList(I)%LineUnOut,Frmt) Time, ( p%Delim, m%LineList(I)%LineWrOutput(J), J=1,(3+3*m%LineList(I)%N) ) @@ -1346,9 +1578,178 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF ! if line output file flag is on END DO ! I + + + + !------------------------------------------------------------------------ + ! now do the outputs for each Rod! + + DO I=1,p%NRods + + IF (m%RodList(I)%OutFlagList(1) == 1) THEN ! only proceed if the line is flagged to output a file + + ! calculate number of output entries to write for this Rod + RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:9)) & + + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(10:11)) & + + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(12:18)) + + + Frmt = '(F10.4,'//TRIM(Int2LStr(RodNumOuts))//'(A1,e12.5))' ! should evenutally use user specified format? + + L = 1 ! start of index of line output file at first entry + + ! Time + ! m%RodList(I)%RodWrOutput(L) = Time + ! L = L+1 + + ! Node positions + IF (m%RodList(I)%OutFlagList(2) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%r(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node velocities + IF (m%RodList(I)%OutFlagList(3) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%rd(K,J) + L = L+1 + END DO + END DO + END IF + + + ! Node wave velocities (not implemented yet) + IF (m%RodList(I)%OutFlagList(4) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%U(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node buoyancy forces + IF (m%RodList(I)%OutFlagList(5) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Bo(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node drag forces + IF (m%RodList(I)%OutFlagList(6) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Dp(K,J) + m%RodList(I)%Dq(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node inertia forces + IF (m%RodList(I)%OutFlagList(7) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Ap(K,J) + m%RodList(I)%Aq(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node dynamic pressure forces + IF (m%RodList(I)%OutFlagList(8) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Pd(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node seabed contact force + IF (m%RodList(I)%OutFlagList(9) == 1) THEN + DO J = 0,m%RodList(I)%N + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%B(K,J) + L = L+1 + END DO + END DO + END IF + + + ! Node weights + IF (m%RodList(I)%OutFlagList(10) == 1) THEN + DO J = 0,m%RodList(I)%N + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%W(3,J) + L = L+1 + END DO + END IF + + ! ! Node curvatures + ! IF (m%RodList(I)%OutFlagList(8) == 1) THEN + ! DO J = 0,m%RodList(I)%N + ! m%RodList(I)%RodWrOutput(L) = m%RodList(I)%W(3,J) + ! L = L+1 + ! END DO + ! END IF + + + ! Segment tension force (excludes damping term, just EA) + ! N/A + + ! Segment internal damping force + ! N/A + + ! Segment strain + ! N/A + + ! Segment strain rate + ! N/A + + + WRITE(m%RodList(I)%RodUnOut,Frmt) Time, ( p%Delim, m%RodList(I)%RodWrOutput(J), J=1,(RodNumOuts) ) + + END IF ! if line output file flag is on + + END DO ! I 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) + + 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 + REAL(DbKi) :: Tmag_squared + + if (i==0) then + NodeTen = sqrt( Line%Fnet(1,i)**2 + Line%Fnet(2,i)**2 + Line%Fnet(3,i)**2 ) ! if an end node, use Fnet which already includes weight + else if (i==Line%N) then + NodeTen = sqrt( Line%Fnet(1,i)**2 + Line%Fnet(2,i)**2 + Line%Fnet(3,i)**2 ) + else + Tmag_squared = 0.0_DbKi + DO J=1,3 + Tmag_squared = Tmag_squared + 0.25*(Line%T(J,i) + Line%Td(J,i) + Line%T(J,i+1) + Line%Td(J,i+1))**2 ! take average of tension in adjacent segments + END DO + NodeTen = sqrt(Tmag_squared) + end if + + END FUNCTION Line_GetNodeTen + !-------------------------------------------------------------- END MODULE MoorDyn_IO diff --git a/modules/moordyn/src/MoorDyn_Line.f90 b/modules/moordyn/src/MoorDyn_Line.f90 new file mode 100644 index 0000000000..0974a2c092 --- /dev/null +++ b/modules/moordyn/src/MoorDyn_Line.f90 @@ -0,0 +1,1634 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall +! +! This file is part of MoorDyn. +! +! 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 MoorDyn_Line + + USE MoorDyn_Types + USE MoorDyn_IO + USE NWTC_Library + USE MoorDyn_Misc + + IMPLICIT NONE + + PRIVATE + + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output + + PUBLIC :: SetupLine + PUBLIC :: Line_Initialize + PUBLIC :: Line_SetState + PUBLIC :: Line_GetStateDeriv + PUBLIC :: Line_SetEndKinematics + PUBLIC :: Line_GetEndStuff + PUBLIC :: Line_GetEndSegmentInfo + PUBLIC :: Line_SetEndOrientation + + + +CONTAINS + + + !----------------------------------------------------------------------- + ! >>>>>>>>>>>>>> rename/reorganize this subroutine >>>>>>>>>>>>> + SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) + ! allocate arrays in line object + + TYPE(MD_Line), INTENT(INOUT) :: Line ! the single line object of interest + TYPE(MD_LineProp), INTENT(INOUT) :: LineProp ! the single line property set for the line of interest + TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters + 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(IntKi) :: N + REAL(DbKi) :: temp + + + N = Line%N ! number of segments in this line (for code readability) + + ! -------------- save some section properties to the line object itself ----------------- + + Line%d = LineProp%d + Line%rho = LineProp%w/(Pi/4.0 * Line%d * Line%d) + + 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%Can = LineProp%Can + Line%Cat = LineProp%Cat + Line%Cdn = LineProp%Cdn + Line%Cdt = LineProp%Cdt + + ! copy over elasticity data + Line%ElasticMod = LineProp%ElasticMod + + Line%nEApoints = LineProp%nEApoints + DO I = 1,Line%nEApoints + Line%stiffXs(I) = LineProp%stiffXs(I) + Line%stiffYs(I) = LineProp%stiffYs(I) ! note: this does not convert to E (not EA) like done in C version + END DO + + Line%nBApoints = LineProp%nBApoints + DO I = 1,Line%nBApoints + Line%dampXs(I) = LineProp%dampXs(I) + Line%dampYs(I) = LineProp%dampYs(I) + END DO + + Line%nEIpoints = LineProp%nEIpoints + DO I = 1,Line%nEIpoints + Line%bstiffXs(I) = LineProp%bstiffXs(I) + Line%bstiffYs(I) = LineProp%bstiffYs(I) ! copy over + END DO + + + + ! Specify specific internal damping coefficient (BA) for this line. + ! Will be equal to inputted BA of LineType if input value is positive. + ! If input value is negative, it is considered to be desired damping ratio (zeta) + ! from which the line's BA can be calculated based on the segment natural frequency. + IF (LineProp%BA < 0) THEN + ! - we assume desired damping coefficient is zeta = -LineProp%BA + ! - highest axial vibration mode of a segment is wn = sqrt(k/m) = 2N/UnstrLen*sqrt(EA/w) + Line%BA = -LineProp%BA * Line%UnstrLen / Line%N * SQRT(LineProp%EA * LineProp%w) + IF (wordy > 1) print *, 'Based on zeta, BA set to ', Line%BA + + IF (wordy > 1) print *, 'Negative BA input detected, treating as -zeta. For zeta = ', -LineProp%BA, ', setting BA to ', Line%BA + + ELSE + Line%BA = LineProp%BA + IF (wordy > 1) temp = Line%N * Line%BA / Line%UnstrLen * SQRT(1.0/(LineProp%EA * LineProp%w)) + IF (wordy > 1) print *, 'BA set as input to ', Line%BA, '. Corresponding zeta is ', temp + END IF + + !temp = 2*Line%N / Line%UnstrLen * sqrt( LineProp%EA / LineProp%w) / TwoPi + !print *, 'Segment natural frequency is ', temp, ' Hz' + + + !print *, "Line ElasticMod is ", Line%ElasticMod + !print *, "EA (static value) is", Line%EA + !print *, "EA_D is", Line%EA_D + !print *, "BA is", Line%BA + !print *, "BA_D is", Line%BA_D + + + ! allocate node positions and velocities (NOTE: these arrays start at ZERO) + ALLOCATE ( Line%r(3, 0:N), Line%rd(3, 0:N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating r and rd arrays.' + !CALL CleanUp() + RETURN + END IF + + ! if using viscoelastic model, allocate additional state quantities + if (Line%ElasticMod == 2) then + ALLOCATE ( Line%dl_1(N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating dl_1 array.' + !CALL CleanUp() + RETURN + END IF + ! initialize to zero + Line%dl_1 = 0.0_DbKi + end if + + ! allocate node and segment tangent vectors + ALLOCATE ( Line%q(3, 0:N), Line%qs(3, N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating q or qs array.' + !CALL CleanUp() + RETURN + 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 ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating segment scalar quantity arrays.' + !CALL CleanUp() + RETURN + END IF + Line%Kurv = 0.0_DbKi + + ! assign values for l, ld, and V + DO J=1,N + Line%l(J) = Line%UnstrLen/REAL(N, DbKi) + Line%ld(J)= 0.0_DbKi + Line%V(J) = Line%l(J)*0.25*Pi*LineProp%d*LineProp%d + END DO + + ! allocate water related vectors + ALLOCATE ( Line%U(3, 0:N), Line%Ud(3, 0:N), Line%zeta(0:N), Line%PDyn(0:N), STAT = ErrStat ) + ! set to zero initially (important of wave kinematics are not being used) + Line%U = 0.0_DbKi + Line%Ud = 0.0_DbKi + Line%zeta = 0.0_DbKi + Line%PDyn = 0.0_DbKi + + ! allocate segment tension and internal damping force vectors + ALLOCATE ( Line%T(3, N), Line%Td(3, N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating T and Td arrays.' + !CALL CleanUp() + RETURN + END IF + + ! allocate node force vectors + ALLOCATE ( Line%W(3, 0:N), Line%Dp(3, 0:N), Line%Dq(3, 0:N), Line%Ap(3, 0:N), & + Line%Aq(3, 0:N), Line%B(3, 0:N), Line%Bs(3, 0:N), Line%Fnet(3, 0:N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating node force arrays.' + !CALL CleanUp() + RETURN + END IF + + ! set gravity and bottom contact forces to zero initially (because the horizontal components should remain at zero) + Line%W = 0.0_DbKi + Line%B = 0.0_DbKi + + ! allocate mass and inverse mass matrices for each node (including ends) + ALLOCATE ( Line%S(3, 3, 0:N), Line%M(3, 3, 0:N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating T and Td arrays.' + !CALL CleanUp() + 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 <<< + + + END SUBROUTINE SetupLine + !-------------------------------------------------------------- + + + + + + !----------------------------------------------------------------------------------------======= + SUBROUTINE Line_Initialize (Line, LineProp, rhoW, ErrStat, ErrMsg) + ! calculate initial profile of the line using quasi-static model + + TYPE(MD_Line), INTENT(INOUT) :: Line ! the single line object of interest + TYPE(MD_LineProp), INTENT(INOUT) :: LineProp ! the single line property set for the line of interest + REAL(DbKi), INTENT(IN) :: rhoW + INTEGER, INTENT( INOUT ) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT( INOUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + REAL(DbKi) :: COSPhi ! Cosine of the angle between the xi-axis of the inertia frame and the X-axis of the local coordinate system of the current mooring line (-) + REAL(DbKi) :: SINPhi ! Sine of the angle between the xi-axis of the inertia frame and the X-axis of the local coordinate system of the current mooring line (-) + REAL(DbKi) :: XF ! Horizontal distance between anchor and fairlead of the current mooring line (meters) + REAL(DbKi) :: ZF ! Vertical distance between anchor and fairlead of the current mooring line (meters) + INTEGER(4) :: I ! Generic index + INTEGER(4) :: J ! Generic index + + + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None + REAL(DbKi) :: WetWeight + REAL(DbKi) :: SeabedCD = 0.0_DbKi + REAL(DbKi) :: TenTol = 0.0001_DbKi + REAL(DbKi), ALLOCATABLE :: LSNodes(:) + REAL(DbKi), ALLOCATABLE :: LNodesX(:) + REAL(DbKi), ALLOCATABLE :: LNodesZ(:) + INTEGER(IntKi) :: N + + + N = Line%N ! for convenience + + ! try to calculate initial line profile using catenary routine (from FAST v.7) + ! note: much of this function is adapted from the FAST source code + + ! Transform the fairlead location from the inertial frame coordinate system + ! to the local coordinate system of the current line (this coordinate + ! system lies at the current anchor, Z being vertical, and X directed from + ! current anchor to the current fairlead). Also, compute the orientation + ! of this local coordinate system: + + XF = SQRT( ( Line%r(1,N) - Line%r(1,0) )**2.0 + ( Line%r(2,N) - Line%r(2,0) )**2.0 ) + ZF = Line%r(3,N) - Line%r(3,0) + + IF ( XF == 0.0 ) THEN ! .TRUE. if the current mooring line is exactly vertical; thus, the solution below is ill-conditioned because the orientation is undefined; so set it such that the tensions and nodal positions are only vertical + COSPhi = 0.0_DbKi + SINPhi = 0.0_DbKi + ELSE ! The current mooring line must not be vertical; use simple trigonometry + COSPhi = ( Line%r(1,N) - Line%r(1,0) )/XF + SINPhi = ( Line%r(2,N) - Line%r(2,0) )/XF + ENDIF + + WetWeight = LineProp%w - 0.25*Pi*LineProp%d*LineProp%d*rhoW + + !LineNodes = Line%N + 1 ! number of nodes in line for catenary model to worry about + + ! allocate temporary arrays for catenary routine + ALLOCATE ( LSNodes(N+1), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating LSNodes array.' + CALL CleanUp() + RETURN + END IF + + ALLOCATE ( LNodesX(N+1), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating LNodesX array.' + CALL CleanUp() + RETURN + END IF + + ALLOCATE ( LNodesZ(N+1), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating LNodesZ array.' + CALL CleanUp() + RETURN + END IF + + ! Assign node arc length locations + LSNodes(1) = 0.0_DbKi + DO I=2,N + LSNodes(I) = LSNodes(I-1) + Line%l(I-1) ! note: l index is because line segment indices start at 1 + END DO + LSNodes(N+1) = Line%UnstrLen ! ensure the last node length isn't longer than the line due to numerical error + + ! Solve the analytical, static equilibrium equations for a catenary (or + ! taut) mooring line with seabed interaction in order to find the + ! horizontal and vertical tensions at the fairlead in the local coordinate + ! system of the current line: + ! NOTE: The values for the horizontal and vertical tensions at the fairlead + ! from the previous time step are used as the initial guess values at + ! at this time step (because the LAnchHTe(:) and LAnchVTe(:) arrays + ! are stored in a module and thus their values are saved from CALL to + ! CALL). + + + CALL Catenary ( XF , ZF , Line%UnstrLen, LineProp%EA , & + WetWeight , SeabedCD, TenTol, (N+1) , & + LSNodes, LNodesX, LNodesZ , ErrStat2, ErrMsg2) + + IF (ErrStat2 == ErrID_None) THEN ! if it worked, use it + ! Transform the positions of each node on the current line from the local + ! coordinate system of the current line to the inertial frame coordinate + ! system: + + DO J = 0,N ! Loop through all nodes per line where the line position and tension can be output + Line%r(1,J) = Line%r(1,0) + LNodesX(J+1)*COSPhi + Line%r(2,J) = Line%r(2,0) + LNodesX(J+1)*SINPhi + Line%r(3,J) = Line%r(3,0) + LNodesZ(J+1) + ENDDO ! J - All nodes per line where the line position and tension can be output + + + ELSE ! if there is a problem with the catenary approach, just stretch the nodes linearly between fairlead and anchor + + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'Line_Initialize') + +! print *, "Node positions: " + + DO J = 0,N ! Loop through all nodes per line where the line position and tension can be output + Line%r(1,J) = Line%r(1,0) + (Line%r(1,N) - Line%r(1,0))*REAL(J, DbKi)/REAL(N, DbKi) + 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 + + + + CALL CleanUp() ! deallocate temporary arrays + + + + CONTAINS + + + !----------------------------------------------------------------------- + SUBROUTINE CleanUp() + ! deallocate temporary arrays + + IF (ALLOCATED(LSNodes)) DEALLOCATE(LSNodes) + IF (ALLOCATED(LNodesX)) DEALLOCATE(LNodesX) + IF (ALLOCATED(LNodesZ)) DEALLOCATE(LNodesZ) + + END SUBROUTINE CleanUp + !----------------------------------------------------------------------- + + + !----------------------------------------------------------------------- + SUBROUTINE Catenary ( XF_In, ZF_In, L_In , EA_In, & + W_In , CB_In, Tol_In, N , & + s_In , X_In , Z_In , ErrStat, ErrMsg ) + + ! This subroutine is copied from FAST v7 with minor modifications + + ! This routine solves the analytical, static equilibrium equations + ! for a catenary (or taut) mooring line with seabed interaction. + ! Stretching of the line is accounted for, but bending stiffness + ! is not. Given the mooring line properties and the fairlead + ! position relative to the anchor, this routine finds the line + ! configuration and tensions. Since the analytical solution + ! involves two nonlinear equations (XF and ZF) in two unknowns + ! (HF and VF), a Newton-Raphson iteration scheme is implemented in + ! order to solve for the solution. The values of HF and VF that + ! are passed into this routine are used as the initial guess in + ! the iteration. The Newton-Raphson iteration is only accurate in + ! double precision, so all of the input/output arguments are + ! converteds to/from double precision from/to default precision. + + ! >>>> TO DO: streamline this function, if it's still to be used at all <<<< + + ! USE Precision + + + IMPLICIT NONE + + + ! Passed Variables: + + INTEGER(4), INTENT(IN ) :: N ! Number of nodes where the line position and tension can be output (-) + + REAL(DbKi), INTENT(IN ) :: CB_In ! Coefficient of seabed static friction drag (a negative value indicates no seabed) (-) + REAL(DbKi), INTENT(IN ) :: EA_In ! Extensional stiffness of line (N) + ! REAL(DbKi), INTENT( OUT) :: HA_In ! Effective horizontal tension in line at the anchor (N) + ! REAL(DbKi), INTENT(INOUT) :: HF_In ! Effective horizontal tension in line at the fairlead (N) + REAL(DbKi), INTENT(IN ) :: L_In ! Unstretched length of line (meters) + REAL(DbKi), INTENT(IN ) :: s_In (N) ! Unstretched arc distance along line from anchor to each node where the line position and tension can be output (meters) + ! REAL(DbKi), INTENT( OUT) :: Te_In (N) ! Effective line tensions at each node (N) + REAL(DbKi), INTENT(IN ) :: Tol_In ! Convergence tolerance within Newton-Raphson iteration specified as a fraction of tension (-) + ! REAL(DbKi), INTENT( OUT) :: VA_In ! Effective vertical tension in line at the anchor (N) + ! REAL(DbKi), INTENT(INOUT) :: VF_In ! Effective vertical tension in line at the fairlead (N) + REAL(DbKi), INTENT(IN ) :: W_In ! Weight of line in fluid per unit length (N/m) + REAL(DbKi), INTENT( OUT) :: X_In (N) ! Horizontal locations of each line node relative to the anchor (meters) + REAL(DbKi), INTENT(IN ) :: XF_In ! Horizontal distance between anchor and fairlead (meters) + REAL(DbKi), INTENT( OUT) :: Z_In (N) ! Vertical locations of each line node relative to the anchor (meters) + REAL(DbKi), INTENT(IN ) :: ZF_In ! Vertical distance between anchor and fairlead (meters) + 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(DbKi) :: CB ! Coefficient of seabed static friction (a negative value indicates no seabed) (-) + REAL(DbKi) :: CBOvrEA ! = CB/EA + REAL(DbKi) :: DET ! Determinant of the Jacobian matrix (m^2/N^2) + REAL(DbKi) :: dHF ! Increment in HF predicted by Newton-Raphson (N) + REAL(DbKi) :: dVF ! Increment in VF predicted by Newton-Raphson (N) + REAL(DbKi) :: dXFdHF ! Partial derivative of the calculated horizontal distance with respect to the horizontal fairlead tension (m/N): dXF(HF,VF)/dHF + REAL(DbKi) :: dXFdVF ! Partial derivative of the calculated horizontal distance with respect to the vertical fairlead tension (m/N): dXF(HF,VF)/dVF + REAL(DbKi) :: dZFdHF ! Partial derivative of the calculated vertical distance with respect to the horizontal fairlead tension (m/N): dZF(HF,VF)/dHF + REAL(DbKi) :: dZFdVF ! Partial derivative of the calculated vertical distance with respect to the vertical fairlead tension (m/N): dZF(HF,VF)/dVF + REAL(DbKi) :: EA ! Extensional stiffness of line (N) + REAL(DbKi) :: EXF ! Error function between calculated and known horizontal distance (meters): XF(HF,VF) - XF + REAL(DbKi) :: EZF ! Error function between calculated and known vertical distance (meters): ZF(HF,VF) - ZF + REAL(DbKi) :: HA ! Effective horizontal tension in line at the anchor (N) + REAL(DbKi) :: HF ! Effective horizontal tension in line at the fairlead (N) + REAL(DbKi) :: HFOvrW ! = HF/W + REAL(DbKi) :: HFOvrWEA ! = HF/WEA + REAL(DbKi) :: L ! Unstretched length of line (meters) + REAL(DbKi) :: Lamda0 ! Catenary parameter used to generate the initial guesses of the horizontal and vertical tensions at the fairlead for the Newton-Raphson iteration (-) + REAL(DbKi) :: LMax ! Maximum stretched length of the line with seabed interaction beyond which the line would have to double-back on itself; here the line forms an "L" between the anchor and fairlead (i.e. it is horizontal along the seabed from the anchor, then vertical to the fairlead) (meters) + REAL(DbKi) :: LMinVFOvrW ! = L - VF/W + REAL(DbKi) :: LOvrEA ! = L/EA + REAL(DbKi) :: s (N) ! Unstretched arc distance along line from anchor to each node where the line position and tension can be output (meters) + REAL(DbKi) :: sOvrEA ! = s(I)/EA + REAL(DbKi) :: SQRT1VFOvrHF2 ! = SQRT( 1.0_DbKi + VFOvrHF2 ) + REAL(DbKi) :: SQRT1VFMinWLOvrHF2 ! = SQRT( 1.0_DbKi + VFMinWLOvrHF2 ) + REAL(DbKi) :: SQRT1VFMinWLsOvrHF2 ! = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) + REAL(DbKi) :: Te (N) ! Effective line tensions at each node (N) + REAL(DbKi) :: Tol ! Convergence tolerance within Newton-Raphson iteration specified as a fraction of tension (-) + REAL(DbKi) :: VA ! Effective vertical tension in line at the anchor (N) + REAL(DbKi) :: VF ! Effective vertical tension in line at the fairlead (N) + REAL(DbKi) :: VFMinWL ! = VF - WL + REAL(DbKi) :: VFMinWLOvrHF ! = VFMinWL/HF + REAL(DbKi) :: VFMinWLOvrHF2 ! = VFMinWLOvrHF*VFMinWLOvrHF + REAL(DbKi) :: VFMinWLs ! = VFMinWL + Ws + REAL(DbKi) :: VFMinWLsOvrHF ! = VFMinWLs/HF + REAL(DbKi) :: VFOvrHF ! = VF/HF + REAL(DbKi) :: VFOvrHF2 ! = VFOvrHF*VFOvrHF + REAL(DbKi) :: VFOvrWEA ! = VF/WEA + REAL(DbKi) :: W ! Weight of line in fluid per unit length (N/m) + REAL(DbKi) :: WEA ! = W*EA + REAL(DbKi) :: WL ! Total weight of line in fluid (N): W*L + REAL(DbKi) :: Ws ! = W*s(I) + REAL(DbKi) :: X (N) ! Horizontal locations of each line node relative to the anchor (meters) + REAL(DbKi) :: XF ! Horizontal distance between anchor and fairlead (meters) + REAL(DbKi) :: XF2 ! = XF*XF + REAL(DbKi) :: Z (N) ! Vertical locations of each line node relative to the anchor (meters) + REAL(DbKi) :: ZF ! Vertical distance between anchor and fairlead (meters) + REAL(DbKi) :: ZF2 ! = ZF*ZF + + INTEGER(4) :: I ! Index for counting iterations or looping through line nodes (-) + INTEGER(4) :: MaxIter ! Maximum number of Newton-Raphson iterations possible before giving up (-) + + LOGICAL :: FirstIter ! Flag to determine whether or not this is the first time through the Newton-Raphson interation (flag) + + + ErrStat = ERrId_None + + + ! The Newton-Raphson iteration is only accurate in double precision, so + ! convert the input arguments into double precision: + + CB = REAL( CB_In , DbKi ) + EA = REAL( EA_In , DbKi ) + HF = 0.0_DbKi ! = REAL( HF_In , DbKi ) + L = REAL( L_In , DbKi ) + s (:) = REAL( s_In (:), DbKi ) + Tol = REAL( Tol_In , DbKi ) + VF = 0.0_DbKi ! keeping this for some error catching functionality? (at first glance) ! VF = REAL( VF_In , DbKi ) + W = REAL( W_In , DbKi ) + XF = REAL( XF_In , DbKi ) + ZF = REAL( ZF_In , DbKi ) + + + + ! HF and VF cannot be initialized to zero when a portion of the line rests on the seabed and the anchor tension is nonzero + + ! Generate the initial guess values for the horizontal and vertical tensions + ! at the fairlead in the Newton-Raphson iteration for the catenary mooring + ! line solution. Use starting values documented in: Peyrot, Alain H. and + ! Goulois, A. M., "Analysis Of Cable Structures," Computers & Structures, + ! Vol. 10, 1979, pp. 805-813: + XF2 = XF*XF + ZF2 = ZF*ZF + + IF ( XF == 0.0_DbKi ) THEN ! .TRUE. if the current mooring line is exactly vertical + Lamda0 = 1.0D+06 + ELSEIF ( L <= SQRT( XF2 + ZF2 ) ) THEN ! .TRUE. if the current mooring line is taut + Lamda0 = 0.2_DbKi + ELSE ! The current mooring line must be slack and not vertical + Lamda0 = SQRT( 3.0_DbKi*( ( L**2 - ZF2 )/XF2 - 1.0_DbKi ) ) + ENDIF + + HF = ABS( 0.5_DbKi*W* XF/ Lamda0 ) + VF = 0.5_DbKi*W*( ZF/TANH(Lamda0) + L ) + + + ! Abort when there is no solution or when the only possible solution is + ! illogical: + + IF ( Tol <= EPSILON(TOL) ) THEN ! .TRUE. when the convergence tolerance is specified incorrectly + ErrStat = ErrID_Warn + ErrMsg = ' Convergence tolerance must be greater than zero in routine Catenary().' + return + ELSEIF ( XF < 0.0_DbKi ) THEN ! .TRUE. only when the local coordinate system is not computed correctly + ErrStat = ErrID_Warn + ErrMsg = ' The horizontal distance between an anchor and its'// & + ' fairlead must not be less than zero in routine Catenary().' + return + + ELSEIF ( ZF < 0.0_DbKi ) THEN ! .TRUE. if the fairlead has passed below its anchor + ErrStat = ErrID_Warn + ErrMsg = " A line's fairlead is defined as below its anchor. You may need to swap a line's fairlead and anchor end nodes." + return + + ELSEIF ( L <= 0.0_DbKi ) THEN ! .TRUE. when the unstretched line length is specified incorrectly + ErrStat = ErrID_Warn + ErrMsg = ' Unstretched length of line must be greater than zero in routine Catenary().' + return + + ELSEIF ( EA <= 0.0_DbKi ) THEN ! .TRUE. when the unstretched line length is specified incorrectly + ErrStat = ErrID_Warn + ErrMsg = ' Extensional stiffness of line must be greater than zero in routine Catenary().' + return + + ELSEIF ( W == 0.0_DbKi ) THEN ! .TRUE. when the weight of the line in fluid is zero so that catenary solution is ill-conditioned + ErrStat = ErrID_Warn + ErrMsg = ' The weight of the line in fluid must not be zero. '// & + ' Routine Catenary() cannot solve quasi-static mooring line solution.' + return + + + ELSEIF ( W > 0.0_DbKi ) THEN ! .TRUE. when the line will sink in fluid + + LMax = XF - EA/W + SQRT( (EA/W)*(EA/W) + 2.0_DbKi*ZF*EA/W ) ! Compute the maximum stretched length of the line with seabed interaction beyond which the line would have to double-back on itself; here the line forms an "L" between the anchor and fairlead (i.e. it is horizontal along the seabed from the anchor, then vertical to the fairlead) + + IF ( ( L >= LMax ) .AND. ( CB >= 0.0_DbKi ) ) then ! .TRUE. if the line is as long or longer than its maximum possible value with seabed interaction + ErrStat = ErrID_Warn + ErrMsg = ' Unstretched mooring line length too large. '// & + ' Routine Catenary() cannot solve quasi-static mooring line solution.' + return + END IF + + ENDIF + + + ! Initialize some commonly used terms that don't depend on the iteration: + + WL = W *L + WEA = W *EA + LOvrEA = L /EA + CBOvrEA = CB /EA + MaxIter = INT(1.0_DbKi/Tol) ! Smaller tolerances may take more iterations, so choose a maximum inversely proportional to the tolerance + + + + ! To avoid an ill-conditioned situation, ensure that the initial guess for + ! HF is not less than or equal to zero. Similarly, avoid the problems + ! associated with having exactly vertical (so that HF is zero) or exactly + ! horizontal (so that VF is zero) lines by setting the minimum values + ! equal to the tolerance. This prevents us from needing to implement + ! the known limiting solutions for vertical or horizontal lines (and thus + ! complicating this routine): + + HF = MAX( HF, Tol ) + XF = MAX( XF, Tol ) + ZF = MAX( ZF, TOl ) + + + + ! Solve the analytical, static equilibrium equations for a catenary (or + ! taut) mooring line with seabed interaction: + + ! Begin Newton-Raphson iteration: + + I = 1 ! Initialize iteration counter + FirstIter = .TRUE. ! Initialize iteration flag + + DO + + + ! Initialize some commonly used terms that depend on HF and VF: + + VFMinWL = VF - WL + LMinVFOvrW = L - VF/W + HFOvrW = HF/W + HFOvrWEA = HF/WEA + VFOvrWEA = VF/WEA + VFOvrHF = VF/HF + VFMinWLOvrHF = VFMinWL/HF + VFOvrHF2 = VFOvrHF *VFOvrHF + VFMinWLOvrHF2 = VFMinWLOvrHF*VFMinWLOvrHF + SQRT1VFOvrHF2 = SQRT( 1.0_DbKi + VFOvrHF2 ) + SQRT1VFMinWLOvrHF2 = SQRT( 1.0_DbKi + VFMinWLOvrHF2 ) + + + ! Compute the error functions (to be zeroed) and the Jacobian matrix + ! (these depend on the anticipated configuration of the mooring line): + + IF ( ( CB < 0.0_DbKi ) .OR. ( W < 0.0_DbKi ) .OR. ( VFMinWL > 0.0_DbKi ) ) THEN ! .TRUE. when no portion of the line rests on the seabed + + EXF = ( LOG( VFOvrHF + SQRT1VFOvrHF2 ) & + - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )*HFOvrW & + + LOvrEA* HF - XF + EZF = ( SQRT1VFOvrHF2 & + - SQRT1VFMinWLOvrHF2 )*HFOvrW & + + LOvrEA*( VF - 0.5_DbKi*WL ) - ZF + + dXFdHF = ( LOG( VFOvrHF + SQRT1VFOvrHF2 ) & + - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W & + - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) & + - ( VFMinWLOvrHF + VFMinWLOvrHF2/SQRT1VFMinWLOvrHF2 )/( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W & + + LOvrEA + dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) & + - ( 1.0_DbKi + VFMinWLOvrHF /SQRT1VFMinWLOvrHF2 )/( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W + dZFdHF = ( SQRT1VFOvrHF2 & + - SQRT1VFMinWLOvrHF2 )/ W & + - ( VFOvrHF2 /SQRT1VFOvrHF2 & + - VFMinWLOvrHF2/SQRT1VFMinWLOvrHF2 )/ W + dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 & + - VFMinWLOvrHF /SQRT1VFMinWLOvrHF2 )/ W & + + LOvrEA + + + ELSEIF ( -CB*VFMinWL < HF ) THEN ! .TRUE. when a portion of the line rests on the seabed and the anchor tension is nonzero + + EXF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) *HFOvrW & + - 0.5_DbKi*CBOvrEA*W* LMinVFOvrW*LMinVFOvrW & + + LOvrEA* HF + LMinVFOvrW - XF + EZF = ( SQRT1VFOvrHF2 - 1.0_DbKi )*HFOvrW & + + 0.5_DbKi*VF*VFOvrWEA - ZF + + dXFdHF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) / W & + - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & + + LOvrEA + dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & + + CBOvrEA*LMinVFOvrW - 1.0_DbKi/W + dZFdHF = ( SQRT1VFOvrHF2 - 1.0_DbKi & + - VFOvrHF2 /SQRT1VFOvrHF2 )/ W + dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 )/ W & + + VFOvrWEA + + + ELSE ! 0.0_DbKi < HF <= -CB*VFMinWL ! A portion of the line must rest on the seabed and the anchor tension is zero + + EXF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) *HFOvrW & + - 0.5_DbKi*CBOvrEA*W*( LMinVFOvrW*LMinVFOvrW - ( LMinVFOvrW - HFOvrW/CB )*( LMinVFOvrW - HFOvrW/CB ) ) & + + LOvrEA* HF + LMinVFOvrW - XF + EZF = ( SQRT1VFOvrHF2 - 1.0_DbKi )*HFOvrW & + + 0.5_DbKi*VF*VFOvrWEA - ZF + + dXFdHF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) / W & + - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & + + LOvrEA - ( LMinVFOvrW - HFOvrW/CB )/EA + dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & + + HFOvrWEA - 1.0_DbKi/W + dZFdHF = ( SQRT1VFOvrHF2 - 1.0_DbKi & + - VFOvrHF2 /SQRT1VFOvrHF2 )/ W + dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 )/ W & + + VFOvrWEA + + + ENDIF + + + ! Compute the determinant of the Jacobian matrix and the incremental + ! tensions predicted by Newton-Raphson: + + + DET = dXFdHF*dZFdVF - dXFdVF*dZFdHF + + if ( EqualRealNos( DET, 0.0_DbKi ) ) then +!bjj: there is a serious problem with the debugger here when DET = 0 + ErrStat = ErrID_Warn + ErrMsg = ' Iteration not convergent (DET is 0). '// & + ' Routine Catenary() cannot solve quasi-static mooring line solution.' + return + endif + + + dHF = ( -dZFdVF*EXF + dXFdVF*EZF )/DET ! This is the incremental change in horizontal tension at the fairlead as predicted by Newton-Raphson + dVF = ( dZFdHF*EXF - dXFdHF*EZF )/DET ! This is the incremental change in vertical tension at the fairlead as predicted by Newton-Raphson + + dHF = dHF*( 1.0_DbKi - Tol*I ) ! Reduce dHF by factor (between 1 at I = 1 and 0 at I = MaxIter) that reduces linearly with iteration count to ensure that we converge on a solution even in the case were we obtain a nonconvergent cycle about the correct solution (this happens, for example, if we jump to quickly between a taut and slack catenary) + dVF = dVF*( 1.0_DbKi - Tol*I ) ! Reduce dHF by factor (between 1 at I = 1 and 0 at I = MaxIter) that reduces linearly with iteration count to ensure that we converge on a solution even in the case were we obtain a nonconvergent cycle about the correct solution (this happens, for example, if we jump to quickly between a taut and slack catenary) + + dHF = MAX( dHF, ( Tol - 1.0_DbKi )*HF ) ! To avoid an ill-conditioned situation, make sure HF does not go less than or equal to zero by having a lower limit of Tol*HF [NOTE: the value of dHF = ( Tol - 1.0_DbKi )*HF comes from: HF = HF + dHF = Tol*HF when dHF = ( Tol - 1.0_DbKi )*HF] + + ! Check if we have converged on a solution, or restart the iteration, or + ! Abort if we cannot find a solution: + + IF ( ( ABS(dHF) <= ABS(Tol*HF) ) .AND. ( ABS(dVF) <= ABS(Tol*VF) ) ) THEN ! .TRUE. if we have converged; stop iterating! [The converge tolerance, Tol, is a fraction of tension] + + EXIT + + + ELSEIF ( ( I == MaxIter ) .AND. ( FirstIter ) ) THEN ! .TRUE. if we've iterated MaxIter-times for the first time; + + ! Perhaps we failed to converge because our initial guess was too far off. + ! (This could happen, for example, while linearizing a model via large + ! pertubations in the DOFs.) Instead, use starting values documented in: + ! Peyrot, Alain H. and Goulois, A. M., "Analysis Of Cable Structures," + ! Computers & Structures, Vol. 10, 1979, pp. 805-813: + ! NOTE: We don't need to check if the current mooring line is exactly + ! vertical (i.e., we don't need to check if XF == 0.0), because XF is + ! limited by the tolerance above. + + XF2 = XF*XF + ZF2 = ZF*ZF + + IF ( L <= SQRT( XF2 + ZF2 ) ) THEN ! .TRUE. if the current mooring line is taut + Lamda0 = 0.2_DbKi + ELSE ! The current mooring line must be slack and not vertical + Lamda0 = SQRT( 3.0_DbKi*( ( L*L - ZF2 )/XF2 - 1.0_DbKi ) ) + ENDIF + + HF = MAX( ABS( 0.5_DbKi*W* XF/ Lamda0 ), Tol ) ! As above, set the lower limit of the guess value of HF to the tolerance + VF = 0.5_DbKi*W*( ZF/TANH(Lamda0) + L ) + + + ! Restart Newton-Raphson iteration: + + I = 0 + FirstIter = .FALSE. + dHF = 0.0_DbKi + dVF = 0.0_DbKi + + + ELSEIF ( ( I == MaxIter ) .AND. ( .NOT. FirstIter ) ) THEN ! .TRUE. if we've iterated as much as we can take without finding a solution; Abort + ErrStat = ErrID_Warn + ErrMsg = ' Iteration not convergent. '// & + ' Routine Catenary() cannot solve quasi-static mooring line solution.' + RETURN + + + ENDIF + + + ! Increment fairlead tensions and iteration counter so we can try again: + + HF = HF + dHF + VF = VF + dVF + + I = I + 1 + + + ENDDO + + + + ! We have found a solution for the tensions at the fairlead! + + ! Now compute the tensions at the anchor and the line position and tension + ! at each node (again, these depend on the configuration of the mooring + ! line): + + IF ( ( CB < 0.0_DbKi ) .OR. ( W < 0.0_DbKi ) .OR. ( VFMinWL > 0.0_DbKi ) ) THEN ! .TRUE. when no portion of the line rests on the seabed + + ! Anchor tensions: + + HA = HF + VA = VFMinWL + + + ! Line position and tension at each node: + + DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed + + IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN + ErrStat = ErrID_Warn + ErrMsg = ' All line nodes must be located between the anchor ' & + //'and fairlead (inclusive) in routine Catenary().' + RETURN + END IF + + Ws = W *s(I) ! Initialize + VFMinWLs = VFMinWL + Ws ! some commonly + VFMinWLsOvrHF = VFMinWLs/HF ! used terms + sOvrEA = s(I) /EA ! that depend + SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) + + X (I) = ( LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) & + - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )*HFOvrW & + + sOvrEA* HF + Z (I) = ( SQRT1VFMinWLsOvrHF2 & + - SQRT1VFMinWLOvrHF2 )*HFOvrW & + + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) + Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) + + ENDDO ! I - All nodes where the line position and tension are to be computed + + + ELSEIF ( -CB*VFMinWL < HF ) THEN ! .TRUE. when a portion of the line rests on the seabed and the anchor tension is nonzero + + ! Anchor tensions: + + HA = HF + CB*VFMinWL + VA = 0.0_DbKi + + + ! Line position and tension at each node: + + DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed + + IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN + ErrStat = ErrID_Warn + ErrMsg = ' All line nodes must be located between the anchor ' & + //'and fairlead (inclusive) in routine Catenary().' + RETURN + END IF + + Ws = W *s(I) ! Initialize + VFMinWLs = VFMinWL + Ws ! some commonly + VFMinWLsOvrHF = VFMinWLs/HF ! used terms + sOvrEA = s(I) /EA ! that depend + SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) + + IF ( s(I) <= LMinVFOvrW ) THEN ! .TRUE. if this node rests on the seabed and the tension is nonzero + + X (I) = s(I) & + + sOvrEA*( HF + CB*VFMinWL + 0.5_DbKi*Ws*CB ) + Z (I) = 0.0_DbKi + Te(I) = HF + CB*VFMinWLs + + ELSE ! LMinVFOvrW < s <= L ! This node must be above the seabed + + X (I) = LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) *HFOvrW & + + sOvrEA* HF + LMinVFOvrW - 0.5_DbKi*CB*VFMinWL*VFMinWL/WEA + Z (I) = ( - 1.0_DbKi + SQRT1VFMinWLsOvrHF2 )*HFOvrW & + + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) + 0.5_DbKi* VFMinWL*VFMinWL/WEA + Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) + + ENDIF + + ENDDO ! I - All nodes where the line position and tension are to be computed + + + ELSE ! 0.0_DbKi < HF <= -CB*VFMinWL ! A portion of the line must rest on the seabed and the anchor tension is zero + + ! Anchor tensions: + + HA = 0.0_DbKi + VA = 0.0_DbKi + + + ! Line position and tension at each node: + + DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed + + IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN + ErrStat = ErrID_Warn + ErrMsg = ' All line nodes must be located between the anchor ' & + //'and fairlead (inclusive) in routine Catenary().' + RETURN + END IF + + Ws = W *s(I) ! Initialize + VFMinWLs = VFMinWL + Ws ! some commonly + VFMinWLsOvrHF = VFMinWLs/HF ! used terms + sOvrEA = s(I) /EA ! that depend + SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) + + IF ( s(I) <= LMinVFOvrW - HFOvrW/CB ) THEN ! .TRUE. if this node rests on the seabed and the tension is zero + + X (I) = s(I) + Z (I) = 0.0_DbKi + Te(I) = 0.0_DbKi + + ELSEIF ( s(I) <= LMinVFOvrW ) THEN ! .TRUE. if this node rests on the seabed and the tension is nonzero + + X (I) = s(I) - ( LMinVFOvrW - 0.5_DbKi*HFOvrW/CB )*HF/EA & + + sOvrEA*( HF + CB*VFMinWL + 0.5_DbKi*Ws*CB ) + 0.5_DbKi*CB*VFMinWL*VFMinWL/WEA + Z (I) = 0.0_DbKi + Te(I) = HF + CB*VFMinWLs + + ELSE ! LMinVFOvrW < s <= L ! This node must be above the seabed + + X (I) = LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) *HFOvrW & + + sOvrEA* HF + LMinVFOvrW - ( LMinVFOvrW - 0.5_DbKi*HFOvrW/CB )*HF/EA + Z (I) = ( - 1.0_DbKi + SQRT1VFMinWLsOvrHF2 )*HFOvrW & + + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) + 0.5_DbKi* VFMinWL*VFMinWL/WEA + Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) + + ENDIF + + ENDDO ! I - All nodes where the line position and tension are to be computed + + + ENDIF + + + + ! The Newton-Raphson iteration is only accurate in double precision, so + ! convert the output arguments back into the default precision for real + ! numbers: + + !HA_In = REAL( HA , DbKi ) !mth: for this I only care about returning node positions + !HF_In = REAL( HF , DbKi ) + !Te_In(:) = REAL( Te(:), DbKi ) + !VA_In = REAL( VA , DbKi ) + !VF_In = REAL( VF , DbKi ) + X_In (:) = REAL( X (:), DbKi ) + Z_In (:) = REAL( Z (:), DbKi ) + + END SUBROUTINE Catenary + !----------------------------------------------------------------------- + + + END SUBROUTINE Line_Initialize + !-------------------------------------------------------------- + + + !-------------------------------------------------------------- + SUBROUTINE Line_SetState(Line, X, t) + + TYPE(MD_Line), INTENT(INOUT) :: Line ! the current Line object + Real(DbKi), INTENT(IN ) :: X(:) ! state vector section for this line + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + + INTEGER(IntKi) :: i ! index of segments or nodes along line + INTEGER(IntKi) :: J ! index + + + ! store current time + Line%time = t + + ! set interior node positions and velocities based on state vector + DO I=1,Line%N-1 + DO J=1,3 + + Line%r( J,I) = X( 3*Line%N-3 + 3*I-3 + J) ! get positions + Line%rd(J,I) = X( 3*I-3 + J) ! get velocities + + END DO + END DO + + ! if using viscoelastic model, also set the static stiffness stretch + if (Line%ElasticMod == 2) 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 + end if + + END SUBROUTINE Line_SetState + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, 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 + + ! Real(DbKi), INTENT( IN ) :: X(:) ! state vector, provided + ! Real(DbKi), INTENT( INOUT ) :: Xd(:) ! derivative of state vector, returned ! cahnged to INOUT + ! Real(DbKi), INTENT (IN) :: t ! instantaneous time + ! TYPE(MD_Line), INTENT (INOUT) :: Line ! label for the current line, for convenience + ! TYPE(MD_LineProp), INTENT(IN) :: LineProp ! the single line property set for the line of interest + ! Real(DbKi), INTENT(INOUT) :: FairFtot(:) ! total force on Connect top of line is attached to + ! Real(DbKi), INTENT(INOUT) :: FairMtot(:,:) ! total mass of Connect top of line is attached to + ! Real(DbKi), INTENT(INOUT) :: AnchFtot(:) ! total force on Connect bottom of line is attached to + ! Real(DbKi), INTENT(INOUT) :: AnchMtot(:,:) ! total mass of Connect bottom of line is attached to + + + INTEGER(IntKi) :: i ! index of segments or nodes along line + INTEGER(IntKi) :: J ! index + INTEGER(IntKi) :: K ! index + INTEGER(IntKi) :: N ! number of segments in line + Real(DbKi) :: d ! line diameter + Real(DbKi) :: rho ! line material density [kg/m^3] + Real(DbKi) :: Sum1 ! for summing squares + Real(DbKi) :: dummyLength ! + Real(DbKi) :: m_i ! node mass + Real(DbKi) :: v_i ! node submerged volume + 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) :: SumSqVp ! + Real(DbKi) :: SumSqVq ! + Real(DbKi) :: MagVp ! + Real(DbKi) :: MagVq ! + Real(DbKi) :: MagT ! tension stiffness force magnitude + Real(DbKi) :: MagTd ! tension damping force magnitude + Real(DbKi) :: Xi ! used in interpolating from lookup table + 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) :: Kurvi ! temporary curvature value [1/m] + Real(DbKi) :: pvec(3) ! the p vector used in bending stiffness calcs + Real(DbKi) :: Mforce_im1(3) ! force vector for a contributor to the effect of a bending moment [N] + Real(DbKi) :: Mforce_ip1(3) ! force vector for a contributor to the effect of a bending moment [N] + Real(DbKi) :: Mforce_i( 3) ! force vector for a contributor to the effect of a bending moment [N] + + Real(DbKi) :: depth ! local water depth interpolated from bathymetry grid [m] + Real(DbKi) :: nvec(3) ! local seabed surface normal vector (positive out) + Real(DbKi) :: Fn(3) ! seabed contact normal force vector + Real(DbKi) :: Vn(3) ! normal velocity of a line node relative to the seabed slope [m/s] + Real(DbKi) :: Vsb(3) ! tangent velocity of a line node relative to the seabed slope [m/s] + Real(DbKi) :: Va(3) ! velocity of a line node in the axial or "in-line" direction [m/s] + Real(DbKi) :: Vt(3) ! velocity of a line node in the transverse direction [m/s] + Real(DbKi) :: VtMag ! magnitude of the transverse velocity of a line node [m/s] + Real(DbKi) :: VaMag ! magnitude of the axial velocity of a line node [m/s] + Real(DbKi) :: FkTmax ! maximum kinetic friction force in the transverse direction (scalar) + Real(DbKi) :: FkAmax ! maximum kinetic friction force in the axial direction (scalar) + Real(DbKi) :: FkT(3) ! kinetic friction force in the transverse direction (vector) + Real(DbKi) :: FkA(3) ! kinetic friction force in the axial direction (vector) + !Real(DbKi) :: mc_T ! ratio of the transverse static friction coefficient to the transverse kinetic friction coefficient + !Real(DbKi) :: mc_A ! ratio of the axial static friction coefficient to the axial kinetic friction coefficient + Real(DbKi) :: FfT(3) ! total friction force in the transverse direction + Real(DbKi) :: FfA(3) ! total friction force in the axial direction + Real(DbKi) :: Ff(3) ! total friction force on the line node + + + N = Line%N ! for convenience + d = Line%d + rho = Line%rho + + ! note that end node kinematics should have already been set by attached objects + + ! ! set end node positions and velocities from connect objects' states + ! DO J = 1, 3 + ! Line%r( J,N) = m%ConnectList(Line%FairConnect)%r(J) + ! Line%r( J,0) = m%ConnectList(Line%AnchConnect)%r(J) + ! Line%rd(J,N) = m%ConnectList(Line%FairConnect)%rd(J) + ! Line%rd(J,0) = m%ConnectList(Line%AnchConnect)%rd(J) + ! END DO + + + + ! -------------------- calculate various kinematic quantities --------------------------- + DO I = 1, N + + + ! calculate current (Stretched) segment lengths and unit tangent vectors (qs) for each segment (this is used for bending calculations) + CALL UnitVector(Line%r(:,I-1), Line%r(:,I), Line%qs(:,I), Line%lstr(I)) + + ! should add catch here for if lstr is ever zero + + Sum1 = 0.0_DbKi + DO J = 1, 3 + Sum1 = Sum1 + (Line%r(J,I) - Line%r(J,I-1))*(Line%rd(J,I) - Line%rd(J,I-1)) + END DO + Line%lstrd(I) = Sum1/Line%lstr(I) ! segment stretched length rate of change + + ! Line%V(I) = Pi/4.0 * d*d*Line%l(I) !volume attributed to segment + END DO + + !calculate unit tangent vectors (q) for each internal node based on adjacent node positions + DO I = 1, N-1 + CALL UnitVector(Line%r(:,I-1), Line%r(:,I+1), Line%q(:,I), dummyLength) + END DO + + ! calculate unit tangent vectors for either end node if the line has no bending stiffness of if either end is pinned (otherwise it's already been set via setEndStateFromRod) + if ((Line%endTypeA==0) .or. (Line%EI==0.0)) then + CALL UnitVector(Line%r(:,0), Line%r(:,1), Line%q(:,0), dummyLength) + end if + if ((Line%endTypeB==0) .or. (Line%EI==0.0)) then + CALL UnitVector(Line%r(:,N-1), Line%r(:,N), Line%q(:,N), dummyLength) + end if + + ! apply wave kinematics (if there are any) + DO i=0,N + 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 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) + ELSE IF (I==N) THEN + m_i = pi/8.0 *d*d*Line%l(N)*rho; + v_i = 0.5*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)) + END IF + + DO J=1,3 + DO K=1,3 + IF (J==K) THEN + Line%M(K,J,I) = m_i + p%rhoW*v_i*( Line%Can*(1 - Line%q(J,I)*Line%q(K,I)) + Line%Cat*Line%q(J,I)*Line%q(K,I) ) + ELSE + Line%M(K,J,I) = p%rhoW*v_i*( Line%Can*(-Line%q(J,I)*Line%q(K,I)) + Line%Cat*Line%q(J,I)*Line%q(K,I) ) + END IF + END DO + END DO + + CALL Inverse3by3(Line%S(:,:,I), Line%M(:,:,I)) ! invert mass matrix + END DO + + + ! ------------------ CALCULATE FORCES ON EACH NODE ---------------------------- + + ! loop through the segments + DO I = 1, N + + ! handle nonlinear stiffness if needed + if (Line%nEApoints > 0) then + + Xi = Line%lstr(I)/Line%l(I) - 1.0 ! strain rate based on inputs + Yi = 0.0_DbKi + + ! find stress based on strain + if (Xi < 0.0) then ! if negative strain (compression), zero stress + Yi = 0.0_DbKi + else if (Xi < Line%stiffXs(1)) then ! if strain below first data point, interpolate from zero + Yi = Xi * Line%stiffYs(1)/Line%stiffXs(1) + else if (Xi >= Line%stiffXs(Line%nEApoints)) then ! if strain exceeds last data point, use last data point + Yi = Line%stiffYs(Line%nEApoints) + else ! otherwise we're in range of the table so interpolate! + do J=1, Line%nEApoints-1 ! go through lookup table until next entry exceeds inputted strain rate + if (Line%stiffXs(J+1) > Xi) then + Yi = Line%stiffYs(J) + (Xi-Line%stiffXs(J)) * (Line%stiffYs(J+1)-Line%stiffYs(J))/(Line%stiffXs(J+1)-Line%stiffXs(J)) + exit + end if + end do + end if + + ! calculate a young's modulus equivalent value based on stress/strain + Line%EA = Yi/Xi + end if + + + ! >>>> could do similar as above for nonlinear damping or bending stiffness <<<< + if (Line%nBApoints > 0) print *, 'Nonlinear elastic damping not yet implemented' + if (Line%nEIpoints > 0) print *, 'Nonlinear bending stiffness not yet implemented' + + + ! basic elasticity model + if (Line%ElasticMod == 1) then + ! line tension, inherently including possibility of dynamic length changes in l term + if (Line%lstr(I)/Line%l(I) > 1.0) then + MagT = Line%EA *( Line%lstr(I)/Line%l(I) - 1.0 ) + 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 + + 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 + + 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) + + ! update state derivative for static stiffness stretch (last N entries in the state vector) + Xd( 6*N-6 + I) = ld_1 + + end if + + + do J = 1, 3 + !Line%T(J,I) = Line%EA *( 1.0/Line%l(I) - 1.0/Line%lstr(I) ) * (Line%r(J,I)-Line%r(J,I-1)) + Line%T(J,I) = MagT * Line%qs(J,I) + !Line%Td(J,I) = Line%BA* ( Line%lstrd(I) / Line%l(I) ) * (Line%r(J,I)-Line%r(J,I-1)) / Line%lstr(I) ! note new form of damping coefficient, BA rather than Cint + Line%Td(J,I) = MagTd * Line%qs(J,I) + end do + end do + + + ! Bending loads + Line%Bs = 0.0_DbKi ! zero bending forces + + if (Line%EI > 0) then + ! loop through all nodes to calculate bending forces due to bending stiffness + do i=0,N + + ! end node A case (only if attached to a Rod, i.e. a cantilever rather than pinned connection) + if (i==0) then + + if (Line%endTypeA > 0) then ! if attached to Rod i.e. cantilever connection + + Kurvi = GetCurvature(Line%lstr(1), Line%q(:,0), Line%qs(:,1)) ! curvature (assuming rod angle is node angle which is middle of if there was a segment -1/2) + + pvec = cross_product(Line%q(:,0), Line%qs(:,1)) ! get direction of bending radius axis + + Mforce_ip1 = cross_product(Line%qs(:,1), pvec) ! get direction of resulting force from bending to apply on node i+1 + + call scalevector(pvec, Kurvi*Line%EI, Line%endMomentA) ! record bending moment at end for potential application to attached object + + call scalevector(Mforce_ip1, Kurvi*Line%EI/Line%lstr(1), Mforce_ip1) ! scale force direction vectors by desired moment force magnitudes to get resulting forces on adjacent nodes + + Mforce_i = -Mforce_ip1 ! set force on node i to cancel out forces on adjacent nodes + + ! apply these forces to the node forces + Line%Bs(:,i ) = Line%Bs(:,i ) + Mforce_i + Line%Bs(:,i+1) = Line%Bs(:,i+1) + Mforce_ip1 + + end if + + ! end node A case (only if attached to a Rod, i.e. a cantilever rather than pinned connection) + else if (i==N) then + + if (Line%endTypeB > 0) then ! if attached to Rod i.e. cantilever connection + + Kurvi = GetCurvature(Line%lstr(N), Line%qs(:,N), Line%q(:,N)) ! curvature (assuming rod angle is node angle which is middle of if there was a segment -1/2 + + pvec = cross_product(Line%qs(:,N), Line%q(:,N)) ! get direction of bending radius axis + + Mforce_im1 = cross_product(Line%qs(:,N), pvec) ! get direction of resulting force from bending to apply on node i-1 + + call scalevector(pvec, -Kurvi*Line%EI, Line%endMomentB ) ! record bending moment at end (note end B is oposite sign as end A) + + call scalevector(Mforce_im1, Kurvi*Line%EI/Line%lstr(N), Mforce_im1) ! scale force direction vectors by desired moment force magnitudes to get resulting forces on adjacent nodes + + Mforce_i = Mforce_im1 ! set force on node i to cancel out forces on adjacent nodes + + ! apply these forces to the node forces + Line%Bs(:,i-1) = Line%Bs(:,i-1) + Mforce_im1 + Line%Bs(:,i ) = Line%Bs(:,i ) + Mforce_i + + end if + + else ! internal node + + Kurvi = GetCurvature(Line%lstr(i)+Line%lstr(i+1), Line%qs(:,i), Line%qs(:,i+1)) ! curvature + + pvec = cross_product(Line%qs(:,i), Line%qs(:,i+1)) ! get direction of bending radius axis + + Mforce_im1 = cross_product(Line%qs(:,i ), pvec) ! get direction of resulting force from bending to apply on node i-1 + Mforce_ip1 = cross_product(Line%qs(:,i+1), pvec) ! get direction of resulting force from bending to apply on node i+1 + + ! scale force direction vectors by desired moment force magnitudes to get resulting forces on adjacent nodes + call scalevector(Mforce_im1, Kurvi*Line%EI/Line%lstr(i ), Mforce_im1) + call scalevector(Mforce_ip1, Kurvi*Line%EI/Line%lstr(i+1), Mforce_ip1) + + Mforce_i = -Mforce_im1 - Mforce_ip1 ! set force on node i to cancel out forces on adjacent nodes + + ! apply these forces to the node forces + Line%Bs(:,i-1) = Line%Bs(:,i-1) + Mforce_im1 + Line%Bs(:,i ) = Line%Bs(:,i ) + Mforce_i + Line%Bs(:,i+1) = Line%Bs(:,i+1) + Mforce_ip1 + + end if + + ! record curvature at node + Line%Kurv(i) = Kurvi + + end do ! for i=0,N (looping through nodes) + end if ! if EI > 0 + + + + + ! loop through the nodes + DO I = 0, N + + !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 + ELSE IF (i==N) THEN + Line%W(3,I) = pi/8.0*d*d* Line%l(N)*(rho - 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 + END IF + + ! relative flow velocities + DO J = 1, 3 + Vi(J) = Line%U(J,I) - Line%rd(J,I) ! relative flow velocity over node -- this is where wave velicites would be added + END DO + + ! decomponse relative flow into components + SumSqVp = 0.0_DbKi ! start sums of squares at zero + SumSqVq = 0.0_DbKi + DO J = 1, 3 + Vq(J) = DOT_PRODUCT( Vi , Line%q(:,I) ) * Line%q(J,I); ! tangential relative flow component + Vp(J) = Vi(J) - Vq(J) ! transverse relative flow component + SumSqVq = SumSqVq + Vq(J)*Vq(J) + SumSqVp = SumSqVp + Vp(J)*Vp(J) + END DO + MagVp = sqrt(SumSqVp) ! get magnitudes of flow components + MagVq = sqrt(SumSqVq) + + ! 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 + 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 + 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 + END IF + + ! F-K force from fluid acceleration not implemented yet + + ! 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 + + ! interpolate the local depth from the bathymetry grid and return the vector normal to the seabed slope + CALL getDepthFromBathymetry(m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, Line%r(1,I), Line%r(2,I), depth, nvec) + + IF (Line%r(3,I) < -depth) THEN ! for every line node at or below the seabed + + ! calculate the velocity components of the node relative to the seabed + Vn = DOT_PRODUCT( Line%rd(:,I), nvec) * nvec ! velocity component normal to the local seabed slope + Vsb = Line%rd(:,I) - Vn ! velocity component along (tangent to) the seabed + + ! calculate the normal contact force on the line node + IF (I==0) THEN + Fn = ( (-depth - Line%r(3,I))*nvec(3)*nvec*p%kBot - Vn*p%cBot) * 0.5*d*( Line%l(I+1) ) + ELSE IF (I==N) THEN + Fn = ( (-depth - Line%r(3,I))*nvec(3)*nvec*p%kBot - Vn*p%cBot) * 0.5*d*(Line%l(I) ) + ELSE + Fn = ( (-depth - Line%r(3,I))*nvec(3)*nvec*p%kBot - Vn*p%cBot) * 0.5*d*(Line%l(I) + Line%l(I+1) ) + END IF + + ! calculate the axial and transverse components of the node velocity vector along the seabed + Va = DOT_PRODUCT( Vsb , Line%q(:,I) ) * Line%q(:,I) + Vt = Vsb - Va + + ! calculate the magnitudes of each velocity + VaMag = SQRT(Va(1)**2+Va(2)**2+Va(3)**2) + VtMag = SQRT(Vt(1)**2+Vt(2)**2+Vt(3)**2) + + ! find the maximum possible kinetic friction force using transverse and axial kinetic friction coefficients + FkTmax = p%mu_kT*SQRT(Fn(1)**2+Fn(2)**2+Fn(3)**2) + FkAmax = p%mu_kA*SQRT(Fn(1)**2+Fn(2)**2+Fn(3)**2) + ! turn the maximum kinetic friction forces into vectors in the direction of their velocities + DO J = 1, 3 + IF (VtMag==0) THEN + FkT(J) = 0.0_DbKi + ELSE + FkT(J) = FkTmax*Vt(J)/VtMag + END IF + IF (VaMag==0) THEN + FkA(J) = 0.0_DbKi + ELSE + FkA(J) = FkAmax*Va(J)/VaMag + END IF + END DO + ! calculate the ratio between the static and kinetic coefficients of friction + !mc_T = p%mu_sT/p%mu_kT + !mc_A = p%mu_sA/p%mu_kA + + ! calculate the transverse friction force + IF (p%mu_kT*p%cv*VtMag > p%mc*FkTmax) THEN ! if the friction force of the linear curve is greater than the maximum friction force allowed adjusted for static friction, + FfT = -FkT ! then the friction force is the maximum kinetic friction force vector (constant part of the curve) + ELSE ! if the friction force of the linear curve is less than the maximum friction force allowed adjusted for static friction, + FfT = -p%mu_kT*p%cv*Vt ! then the friction force is the calculated value of the linear line + END IF + ! calculate the axial friction force + IF (p%mu_kA*p%cv*VaMag > p%mc*FkAmax) THEN ! if the friction force of the linear curve is greater than the maximum friction force allowed adjusted for static friction, + FfA = -FkA ! then the friction force is the maximum kinetic friction force vector (constant part of the curve) + ELSE ! if the friction force of the linear curve is less than the maximum friction force allowed adjusted for static friction, + FfA = -p%mu_kA*p%cv*Va ! then the friction force is the calculated value of the linear line + END IF + ! NOTE: these friction forces have a negative sign here to indicate a force in the opposite direction of motion + + ! the total friction force is along the plane of the seabed slope, which is just the vector sum of the transverse and axial components + Ff = FfT + FfA + + ELSE + Fn = 0.0_DbKi + Ff = 0.0_DbKi + END IF + + + ! the total force from bottom contact on the line node is the sum of the normal contact force and the friction force + Line%B(:,I) = Fn + Ff + + ! 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) + 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) + 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) + END IF + + END DO ! I - done looping through nodes + + ! loop through internal nodes and update their states <<< should/could convert to matrix operations instead of all these loops + DO I=1, N-1 + DO J=1,3 + + ! calculate RHS constant (premultiplying force vector by inverse of mass matrix ... i.e. rhs = S*Forces) + Sum1 = 0.0_DbKi ! reset temporary accumulator <<< could turn this into a Line%a array to save and output node accelerations + DO K = 1, 3 + Sum1 = Sum1 + Line%S(K,J,I) * Line%Fnet(K,I) ! matrix-vector multiplication [S i]{Forces i} << double check indices + END DO ! K + + ! update states + Xd(3*N-3 + 3*I-3 + J) = Line%rd(J,I); ! dxdt = V (velocities) + Xd( 3*I-3 + J) = Sum1 ! dVdt = RHS * A (accelerations) + + END DO ! J + END DO ! I + + + ! 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." + IF (wordy > 1) THEN + print *, "state derivatives:" + print *, Xd + + + + print *, "m_i p%rhoW v_i Line%Can Line%Cat" + print *, m_i + print *, p%rhoW + print *, v_i + print *, Line%Can + print *, Line%Cat + + print *, "Line%q" + print *, Line%q + + print *, "Line%r" + print *, Line%r + + + print *, "Here is the mass matrix set" + print *, Line%M + + print *, "Here is the inverted mass matrix set" + print *, Line%S + + print *, "Here is the net force set" + print *, Line%Fnet + END IF + + EXIT + END IF + END DO + + + ! ! add force and mass of end nodes to the Connects they correspond to <<<<<<<<<<<< do this from Connection instead now! + ! DO J = 1,3 + ! FairFtot(J) = FairFtot(J) + Line%F(J,N) + ! AnchFtot(J) = AnchFtot(J) + Line%F(J,0) + ! DO K = 1,3 + ! FairMtot(K,J) = FairMtot(K,J) + Line%M(K,J,N) + ! AnchMtot(K,J) = AnchMtot(K,J) + Line%M(K,J,0) + ! END DO + ! END DO + + END SUBROUTINE Line_GetStateDeriv + !===================================================================== + + + !-------------------------------------------------------------- + SUBROUTINE Line_SetEndKinematics(Line, r_in, rd_in, t, topOfLine) + + TYPE(MD_Line), INTENT(INOUT) :: Line ! the current Line object + Real(DbKi), INTENT(IN ) :: r_in( 3) ! state vector section for this line + Real(DbKi), INTENT(IN ) :: rd_in(3) ! state vector section for this line + 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) :: inode + + IF (topOfLine==1) THEN + inode = Line%N + Line%endTypeB = 0 ! set as ball rather than rigid connection (unless changed later by SetEndOrientation) + ELSE + inode = 0 + Line%endTypeA = 0 ! set as ball rather than rigid connection (unless changed later by SetEndOrientation) + END IF + + !Line%r( :,inode) = r_in + !Line%rd(:,inode) = rd_in + + DO J = 1,3 + Line%r( :,inode) = r_in + Line%rd(:,inode) = rd_in + END DO + + ! print *, "SetEndKinematics of line ", Line%idNum, " top?:", topOfLine + ! print *, r_in + ! print *, Line%r( :,inode), " - confirming, node ", inode + ! print *, rd_in + + Line%time = t + + END SUBROUTINE Line_SetEndKinematics + !-------------------------------------------------------------- + + + ! get force, moment, and mass of line at line end node + !-------------------------------------------------------------- + SUBROUTINE Line_GetEndStuff(Line, Fnet_out, Moment_out, M_out, topOfLine) + + TYPE(MD_Line), INTENT(INOUT) :: Line ! label for the current line, for convenience + REAL(DbKi), INTENT( OUT) :: Fnet_out(3) ! net force on end node + REAL(DbKi), INTENT( OUT) :: Moment_out(3) ! moment on end node (future capability) + 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 + + IF (topOfLine==1) THEN ! end B of line + Fnet_out = Line%Fnet(:, Line%N) + Moment_out = Line%endMomentB + M_out = Line%M(:,:, Line%N) + ELSE ! end A of line + Fnet_out = Line%Fnet(:, 0) + Moment_out = Line%endMomentA + M_out = Line%M(:,:, 0) + END IF + + END SUBROUTINE Line_GetEndStuff + !-------------------------------------------------------------- + + ! Get bending stiffness vector from line end for use in computing orientation of zero-length rods + !-------------------------------------------------------------- + SUBROUTINE Line_GetEndSegmentInfo(Line, q_EI_dl, topOfLine, rodEndB) + + TYPE(MD_Line), INTENT(INOUT) :: Line ! label for the current line, for convenience + REAL(DbKi), INTENT( OUT) :: q_EI_dl(3) ! EI/dl of the line end segment multiplied by the axis unit vector with the correct sign + INTEGER(IntKi), INTENT(IN ) :: topOfLine ! 0 for end A (Node 0), 1 for end B (node N) + INTEGER(IntKi), INTENT(IN ) :: rodEndB ! rodEndB=0 means the line is attached to Rod end A, =1 means attached to Rod end B (implication for unit vector sign) + + REAL(DbKi) :: qEnd(3) + REAL(DbKi) :: dlEnd + + if (topOfLine==1) then + CALL UnitVector(Line%r(:,Line%N-1), Line%r(:,Line%N), qEnd, dlEnd) ! unit vector of last line segment + if (rodEndB == 0) then + q_EI_dl = qEnd*Line%EI/dlEnd ! -----line----->[A==ROD==>B] + else + q_EI_dl = -qEnd*Line%EI/dlEnd ! -----line----->[B==ROD==>A] + end if + else + CALL UnitVector(Line%r(:,0 ), Line%r(:,1 ), qEnd, dlEnd) ! unit vector of first line segment + if (rodEndB == 0) then + q_EI_dl = -qEnd*Line%EI/dlEnd ! <----line-----[A==ROD==>B] + else + q_EI_dl = qEnd*Line%EI/dlEnd ! <----line-----[B==ROD==>A] + end if + end if + + END SUBROUTINE Line_GetEndSegmentInfo + !-------------------------------------------------------------- + + + ! set end node unit vector of a line (this is called when attached to a Rod, only applicable for bending stiffness) + !-------------------------------------------------------------- + SUBROUTINE Line_SetEndOrientation(Line, qin, topOfLine, rodEndB) + + TYPE(MD_Line), INTENT(INOUT) :: Line ! label for the current line, for convenience + REAL(DbKi), INTENT(IN ) :: qin(3) ! the rod's axis unit vector + INTEGER(IntKi), INTENT(IN ) :: topOfLine ! 0 for end A (Node 0), 1 for end B (node N) + INTEGER(IntKi), INTENT(IN ) :: rodEndB ! =0 means the line is attached to Rod end A, =1 means attached to Rod end B (implication for unit vector sign) + + if (topOfLine==1) then + + Line%endTypeB = 1 ! indicate attached to Rod (at every time step, just in case line gets detached) + + if (rodEndB==1) then + Line%q(:,Line%N) = -qin ! -----line----->[B<==ROD==A] + else + Line%q(:,Line%N) = qin ! -----line----->[A==ROD==>B] + end if + else + + Line%endTypeA = 1 ! indicate attached to Rod (at every time step, just in case line gets detached) ! indicate attached to Rod + + if (rodEndB==1) then + Line%q(:,0 ) = qin ! [A==ROD==>B]-----line-----> + else + Line%q(:,0 ) = -qin ! [B<==ROD==A]-----line-----> + end if + end if + + END SUBROUTINE Line_SetEndOrientation + !-------------------------------------------------------------- + + +END MODULE MoorDyn_Line diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 new file mode 100644 index 0000000000..a9d66a6516 --- /dev/null +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -0,0 +1,2110 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall +! +! This file is part of MoorDyn. +! +! 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 MoorDyn_Misc + + USE MoorDyn_Types + USE NWTC_Library + USE NWTC_FFTPACK + + IMPLICIT NONE + + PRIVATE + + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output + + PUBLIC :: UnitVector + PUBLIC :: ScaleVector + PUBLIC :: GetCurvature + PUBLIC :: GetOrientationAngles + PUBLIC :: TransformKinematics + PUBLIC :: TransformKinematicsA + PUBLIC :: TransformKinematicsAtoB + PUBLIC :: TranslateForce3to6DOF + PUBLIC :: TranslateMass3to6DOF + PUBLIC :: TranslateMass6to6DOF + PUBLIC :: GetH + PUBLIC :: RotateM6 + PUBLIC :: RotateM3 + PUBLIC :: CalcOrientation + PUBLIC :: Inverse3by3 + PUBLIC :: LUsolve + + PUBLIC :: getInterpNums + PUBLIC :: calculate4Dinterpolation + PUBLIC :: calculate3Dinterpolation + PUBLIC :: calculate2Dinterpolation + + PUBLIC :: getDepthFromBathymetry + + PUBLIC :: getWaterKin + PUBLIC :: setupWaterKin + +CONTAINS + + + ! ::::::::::::::::::::::::::::::::: math convenience functions :::::::::::::::::::::::::::::::::: + ! should add error checking if I keep these, but hopefully there are existing NWTCLib functions to replace them + + ! return unit vector (u) and in direction from r1 to r2 and distance between points + !----------------------------------------------------------------------- + SUBROUTINE UnitVector( r1, r2, u, Length ) ! note: order of parameters chagned in this function + + REAL(DbKi), INTENT(IN ) :: r1(:) + REAL(DbKi), INTENT(IN ) :: r2(:) + REAL(DbKi), INTENT( OUT) :: u(:) + REAL(DbKi), INTENT( OUT) :: length + + u = r2 - r1 + length = TwoNorm(u) + + if ( .NOT. EqualRealNos(length, 0.0_DbKi ) ) THEN + u = u / Length + END IF + + END SUBROUTINE UnitVector + !----------------------------------------------------------------------- + + ! scale vector to desired length + !----------------------------------------------------------------------- + SUBROUTINE ScaleVector( u_in, newlength, u_out ) + REAL(DbKi), INTENT(IN ) :: u_in(3) ! input vector + REAL(DbKi), INTENT(IN ) :: newlength ! desired length of output vector + REAL(DbKi), INTENT(INOUT) :: u_out(3) ! output vector (hopefully can be the same as u_in without issue) + + REAL(DbKi) :: length_squared + REAL(DbKi) :: scaler + INTEGER(IntKi) :: J + + length_squared = 0.0; + DO J=1,3 + length_squared = length_squared + u_in(J)*u_in(J) + END DO + + if (length_squared > 0) then + scaler = newlength/sqrt(length_squared) + else ! if original vector is zero, return zero + scaler = 0.0_DbKi + end if + + DO J=1,3 + u_out(J) = u_in(J) * scaler + END DO + + END SUBROUTINE ScaleVector + !----------------------------------------------------------------------- + + + ! convenience function to calculate curvature based on adjacent segments' direction vectors and their combined length + function GetCurvature(length, q1, q2) + + real(DbKi), intent(in ) :: length + real(DbKi), intent(in ) :: q1(3) + real(DbKi), intent(in ) :: q2(3) + real(DbKi) :: GetCurvature + + + real(DbKi) :: q1_dot_q2 + + ! note "length" here is combined from both segments + + q1_dot_q2 = dot_product( q1, q2 ) + + if (q1_dot_q2 > 1.0) then ! this is just a small numerical error, so set q1_dot_q2 to 1 + GetCurvature = 0.0_DbKi ! this occurs when there's no curvature, so return zero curvature + + !else if (q1_dot_q2 < 0) ! this is a bend of more than 90 degrees, too much, call an error! + + else ! normal case + GetCurvature = 4.0/length * sqrt(0.5*(1.0 - q1_dot_q2)) ! this is the normal curvature calculation + end if + + return + end function GetCurvature + + + ! calculate orientation angles of a direction vector + !----------------------------------------------------------------------- + subroutine GetOrientationAngles(vec, phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, cosBeta, k_hat) + real(DbKi), intent(in ) :: vec(3) !p1(3),p2(3) + real(DbKi), intent( out) :: phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, cosBeta, k_hat(3) + + real(DbKi) :: vecLen, vecLen2D + + 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 + k_hat = NaN ! 1.0/0.0 + else + k_hat = vec / vecLen + phi = atan2(vecLen2D, vec(3)) ! incline angle + end if + if ( phi < 0.000001) then + beta = 0.0_ReKi + else + beta = atan2(vec(2), vec(1)) ! heading of incline + endif + sinPhi = sin(phi) + cosPhi = cos(phi) + tanPhi = tan(phi) + sinBeta = sin(beta) + cosBeta = cos(beta) + + end subroutine GetOrientationAngles + !----------------------------------------------------------------------- + + + ! calculate position and velocity of point based on its position relative to moving 6DOF body + !----------------------------------------------------------------------- + SUBROUTINE TransformKinematics(rRelBody, r_in, TransMat, rd_in, r_out, rd_out) + REAL(DbKi), INTENT(IN ) :: rRelBody(:) ! coordinate of end A + REAL(DbKi), INTENT(IN ) :: r_in(3) ! Rod unit vector + REAL(DbKi), INTENT(IN ) :: TransMat(3,3)! + REAL(DbKi), INTENT(IN ) :: rd_in(6) ! 6DOF velecity vector about Rod end A, in global orientation frame + REAL(DbKi), INTENT( OUT) :: r_out(3) ! coordinates of end B + REAL(DbKi), INTENT( OUT) :: rd_out(3) ! velocity of end B + + REAL(DbKi) :: rRel(3) + + ! rd_in should be in global orientation frame + ! note: it's okay if r_out and rd_out are 6-size. Only the first 3 will be written, and 4-6 will + ! already be correct or can be assigned seperately from r_in and rd_in (assuming orientation frames are identical) + + + ! locations (unrotated reference frame) about platform reference point (2021-01-05: just transposed TransMat, it was incorrect before) + rRel(1) = TransMat(1,1)*rRelBody(1) + TransMat(1,2)*rRelBody(2) + TransMat(1,3)*rRelBody(3) ! x + rRel(2) = TransMat(2,1)*rRelBody(1) + TransMat(2,2)*rRelBody(2) + TransMat(2,3)*rRelBody(3) ! y + rRel(3) = TransMat(3,1)*rRelBody(1) + TransMat(3,2)*rRelBody(2) + TransMat(3,3)*rRelBody(3) ! z + + ! absolute locations + r_out = rRel + r_in + + ! absolute velocities + rd_out(1) = - rd_in(6)*rRel(2) + rd_in(5)*rRel(3) + rd_in(1) ! x + rd_out(2) = rd_in(6)*rRel(1) - rd_in(4)*rRel(3) + rd_in(2) ! y + rd_out(3) = -rd_in(5)*rRel(1) + rd_in(4)*rRel(2) + rd_in(3) ! z + + ! absolute accelerations + rd_out(1) = - rd_in(6)*rRel(2) + rd_in(5)*rRel(3) + rd_in(1) ! x + rd_out(2) = rd_in(6)*rRel(1) - rd_in(4)*rRel(3) + rd_in(2) ! y + rd_out(3) = -rd_in(5)*rRel(1) + rd_in(4)*rRel(2) + rd_in(3) ! z + + + + !rRel = MATMUL(TransMat, rRelBody) + !H = getH(rRel) + !! absolute locations + !r_out = rRel + r_in + !! absolute velocities + !rd_out = MATMUL( H, rd_in(4:6)) + rd_in(1:3) + + + END SUBROUTINE TransformKinematics + !----------------------------------------------------------------------- + + + + ! calculate position, velocity, and acceleration of point based on its position relative to moving 6DOF body + !----------------------------------------------------------------------- + SUBROUTINE TransformKinematicsA(rRelBody, r_in, TransMat, v_in, a_in, r_out, v_out, a_out) + REAL(DbKi), INTENT(IN ) :: rRelBody(:) ! relative location of point about reference point, in local/reference coordinate system + REAL(DbKi), INTENT(IN ) :: r_in(3) ! translation applied to reference point + REAL(DbKi), INTENT(IN ) :: TransMat(3,3)! rotation matrix describing rotation about reference point + REAL(DbKi), INTENT(IN ) :: v_in(6) ! 6DOF velecity vector about ref point in global orientation frame + REAL(DbKi), INTENT(IN ) :: a_in(6) ! 6DOF acceleration vector + REAL(DbKi), INTENT( OUT) :: r_out(3) ! coordinates of point of interest + REAL(DbKi), INTENT( OUT) :: v_out(3) ! velocity of point + REAL(DbKi), INTENT( OUT) :: a_out(3) ! acceleration of point + + REAL(DbKi) :: rRel(3) + REAL(DbKi) :: rRel2(3) + + REAL(DbKi) :: r_out2(3) + REAL(DbKi) :: rd_out2(3) + REAL(DbKi) :: H(3,3) + + ! rd_in should be in global orientation frame + ! note: it's okay if r_out and rd_out are 6-size. Only the first 3 will be written, and 4-6 will + ! already be correct or can be assigned seperately from r_in and rd_in (assuming orientation frames are identical) + + + ! locations about ref point in *unrotated* reference frame + !rRel2(1) = TransMat(1,1)*rRelBody(1) + TransMat(2,1)*rRelBody(2) + TransMat(3,1)*rRelBody(3) ! x + !rRel2(2) = TransMat(1,2)*rRelBody(1) + TransMat(2,2)*rRelBody(2) + TransMat(3,2)*rRelBody(3) ! y + !rRel2(3) = TransMat(1,3)*rRelBody(1) + TransMat(2,3)*rRelBody(2) + TransMat(3,3)*rRelBody(3) ! z + + rRel = MATMUL(TransMat, rRelBody) + + H = getH(rRel) + + ! absolute locations + r_out = rRel + r_in + + ! absolute velocities + !rd_out2(1) = - v_in(6)*rRel(2) + v_in(5)*rRel(3) + v_in(1) ! x + !rd_out2(2) = v_in(6)*rRel(1) - v_in(4)*rRel(3) + v_in(2) ! y + !rd_out2(3) = -v_in(5)*rRel(1) + v_in(4)*rRel(2) + v_in(3) ! z + + v_out = MATMUL( H, v_in(4:6)) + v_in(1:3) + + ! absolute accelerations + a_out = MATMUL( H, a_in(4:6)) + a_in(1:3) ! << should add second order terms! + + + END SUBROUTINE TransformKinematicsA + !----------------------------------------------------------------------- + + ! calculate position and velocity of point along rod (distance L along direction u) + !----------------------------------------------------------------------- + SUBROUTINE TransformKinematicsAtoB(rA, u, L, rd_in, r_out, rd_out) + REAL(DbKi), INTENT(IN ) :: rA(3) ! coordinate of end A + REAL(DbKi), INTENT(IN ) :: u(3) ! Rod unit vector + REAL(DbKi), INTENT(IN ) :: L ! Rod length from end A to B + REAL(DbKi), INTENT(IN ) :: rd_in(6) ! 6DOF velecity vector about Rod end A, in global orientation frame + REAL(DbKi), INTENT( OUT) :: r_out(3) ! coordinates of end B + REAL(DbKi), INTENT( OUT) :: rd_out(3) ! velocity of end B + + REAL(DbKi) :: rRel(3) + + + ! locations (unrotated reference frame) + rRel = L*u ! relative location of point B from point A + r_out = rRel + rA ! absolute location of point B + + ! absolute velocities + rd_out(1) = - rd_in(6)*rRel(2) + rd_in(5)*rRel(3) + rd_in(1) ! x + rd_out(2) = rd_in(6)*rRel(1) - rd_in(4)*rRel(3) + rd_in(2) ! y + rd_out(3) = -rd_in(5)*rRel(1) + rd_in(4)*rRel(2) + rd_in(3) ! z + + + END SUBROUTINE TransformKinematicsAtoB + !----------------------------------------------------------------------- + + ! + !----------------------------------------------------------------------- + SUBROUTINE TranslateForce3to6DOF(dx, F, Fout) + REAL(DbKi), INTENT(IN ) :: dx(3) ! displacement vector from ref point to point of force (F) application + REAL(DbKi), INTENT(IN ) :: F(3) ! applied force + REAL(DbKi), INTENT( OUT) :: Fout(6) ! resultant applied force and moment about ref point + + Fout(1:3) = F + + Fout(4:6) = CROSS_PRODUCT(dx, F) + + END SUBROUTINE TranslateForce3to6DOF + !----------------------------------------------------------------------- + + + ! + !----------------------------------------------------------------------- + SUBROUTINE TranslateMass3to6DOF(dx, Min, Mout) + REAL(DbKi), INTENT(IN ) :: dx(3) ! displacement vector from ref point to point of mass matrix (Min) + REAL(DbKi), INTENT(IN ) :: Min( 3,3) ! original mass matrix (assumed at center of mass, or a point mass) + 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 + + ! sub-matrix definitions are accordint to | m J | + ! | J^T I | + + H = getH(dx); + + ! mass matrix [m'] = [m] + Mout(1:3,1:3) = Min + + ! product of inertia matrix [J'] = [m][H] + [J] + Mout(1:3,4:6) = MATMUL(Min, H) + Mout(4:6,1:3) = TRANSPOSE(Mout(1:3,4:6)) + + !moment of inertia matrix [I'] = [H][m][H]^T + [J]^T [H] + [H]^T [J] + [I] + Mout(4:6,4:6) = MATMUL(MATMUL(H, Min), TRANSPOSE(H)) + + END SUBROUTINE TranslateMass3to6DOF + !----------------------------------------------------------------------- + + ! + !----------------------------------------------------------------------- + SUBROUTINE TranslateMass6to6DOF(dx, Min, Mout) + REAL(DbKi), INTENT(IN ) :: dx(3) ! displacement vector from ref point to point of mass matrix (Min) + REAL(DbKi), INTENT(IN ) :: Min( 6,6) ! original mass matrix + 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 + + H = getH(dx); + + ! mass matrix [m'] = [m] + Mout(1:3,1:3) = Min(1:3,1:3) + + ! product of inertia matrix [J'] = [m][H] + [J] + Mout(1:3,4:6) = MATMUL(Min(1:3,1:3), H) + Min(1:3,4:6) + Mout(4:6,1:3) = TRANSPOSE(Mout(1:3,4:6)) + + !moment of inertia matrix [I'] = [H][m][H]^T + [J]^T [H] + [H]^T [J] + [I] + Mout(4:6,4:6) = MATMUL(MATMUL(H, Min(1:3,1:3)), TRANSPOSE(H)) + MATMUL(Min(4:6,1:3),H) + MATMUL(TRANSPOSE(H),Min(1:3,4:6)) + Min(4:6,4:6) + + END SUBROUTINE TranslateMass6to6DOF + !----------------------------------------------------------------------- + + ! produce alternator matrix + !----------------------------------------------------------------------- + FUNCTION GetH(r) + Real(DbKi), INTENT(IN) :: r(3) ! inputted vector + Real(DbKi) :: GetH(3,3) ! outputted matrix + + GetH(2,1) = -r(3) + GetH(1,2) = r(3) + GetH(3,1) = r(2) + GetH(1,3) = -r(2) + GetH(3,2) = -r(1) + GetH(2,3) = r(1) + + GetH(1,1) = 0.0_DbKi + GetH(2,2) = 0.0_DbKi + GetH(3,3) = 0.0_DbKi + + END FUNCTION GetH + !----------------------------------------------------------------------- + + + + ! apply a rotation to a 6-by-6 mass/inertia tensor (see Sadeghi and Incecik 2005 for theory) + !----------------------------------------------------------------------- + FUNCTION RotateM6(Min, rotMat) result(outMat) + + Real(DbKi), INTENT(IN) :: Min(6,6) ! inputted matrix to be rotated + Real(DbKi), INTENT(IN) :: rotMat(3,3) ! rotation matrix (DCM) + Real(DbKi) :: outMat(6,6) ! rotated matrix + + ! the process for each of the following is to + ! 1. copy out the relevant 3x3 matrix section, + ! 2. rotate it, and + ! 3. paste it into the output 6x6 matrix + + ! mass matrix + outMat(1:3,1:3) = rotateM3(Min(1:3,1:3), rotMat) + + ! product of inertia matrix + outMat(1:3,4:6) = rotateM3(Min(1:3,4:6), rotMat) + outMat(4:6,1:3) = TRANSPOSE(outMat(1:3,4:6)) + + ! moment of inertia matrix + outMat(4:6,4:6) = rotateM3(Min(4:6,4:6), rotMat) + + END FUNCTION RotateM6 + + + ! apply a rotation to a 3-by-3 mass matrix or any other second order tensor + !----------------------------------------------------------------------- + FUNCTION RotateM3(Min, rotMat) result(outMat) + + Real(DbKi), INTENT(IN) :: Min(3,3) ! inputted matrix to be rotated + Real(DbKi), INTENT(IN) :: rotMat(3,3) ! rotation matrix (DCM) + Real(DbKi) :: outMat(3,3) ! rotated matrix + + ! overall operation is [m'] = [a]*[m]*[a]^T + + outMat = MATMUL( MATMUL(rotMat, Min), TRANSPOSE(rotMat) ) + + END FUNCTION RotateM3 + + + + + + ! calculates rotation matrix R to rotate from global axes to a member's local axes + !----------------------------------------------------------------------- + FUNCTION CalcOrientation(phi, beta, gamma) result(R) + + REAL(DbKi), INTENT ( IN ) :: phi ! member incline angle + REAL(DbKi), INTENT ( IN ) :: beta ! member incline heading + REAL(DbKi), INTENT ( IN ) :: gamma ! member twist angle + REAL(DbKi) :: R(3,3) ! rotation matrix + + INTEGER(IntKi) :: errStat + CHARACTER(100) :: errMsg + + REAL(DbKi) :: s1, c1, s2, c2, s3, c3 + + + ! trig terms for Euler angles rotation based on beta, phi, and gamma + s1 = sin(beta) + c1 = cos(beta) + s2 = sin(phi) + c2 = cos(phi) + s3 = sin(gamma) + c3 = cos(gamma) + + ! calculate rotation matrix based on Z1Y2Z3 Euler rotation sequence from https:!en.wikipedia.org/wiki/Euler_angles#Rotation_matrix + + R(1,1) = c1*c2*c3-s1*s3 + R(1,2) = -c3*s1-c1*c2*s3 + R(1,3) = c1*s2 + R(2,1) = c1*s3+c2*c3*s1 + R(2,2) = c1*c3-c2*s1*s3 + R(2,3) = s1*s2 + R(3,1) = -c3*s2 + R(3,2) = s2*s3 + R(3,3) = c2 + + ! could also calculate unit normals p1 and p2 for rectangular cross sections + !p1 = matmul( R, [1,0,0] ) ! unit vector that is perpendicular to the 'beta' plane if gamma is zero + !p2 = cross( q, p1 ) ! unit vector orthogonal to both p1 and q + + END FUNCTION CalcOrientation + + + !compute the inverse of a 3-by-3 matrix m + !----------------------------------------------------------------------- + SUBROUTINE Inverse3by3( Minv, M ) + Real(DbKi), INTENT(OUT) :: Minv(3,3) ! returned inverse matrix + Real(DbKi), INTENT(IN) :: M(3,3) ! inputted matrix + + Real(DbKi) :: det ! the determinant + Real(DbKi) :: invdet ! inverse of the determinant + + det = M(1, 1) * (M(2, 2) * M(3, 3) - M(3, 2) * M(2, 3)) - & + M(1, 2) * (M(2, 1) * M(3, 3) - M(2, 3) * M(3, 1)) + & + M(1, 3) * (M(2, 1) * M(3, 2) - M(2, 2) * M(3, 1)); + + invdet = 1.0 / det ! because multiplying is faster than dividing + + Minv(1, 1) = (M(2, 2) * M(3, 3) - M(3, 2) * M(2, 3)) * invdet + Minv(1, 2) = (M(1, 3) * M(3, 2) - M(1, 2) * M(3, 3)) * invdet + Minv(1, 3) = (M(1, 2) * M(2, 3) - M(1, 3) * M(2, 2)) * invdet + Minv(2, 1) = (M(2, 3) * M(3, 1) - M(2, 1) * M(3, 3)) * invdet + Minv(2, 2) = (M(1, 1) * M(3, 3) - M(1, 3) * M(3, 1)) * invdet + Minv(2, 3) = (M(2, 1) * M(1, 3) - M(1, 1) * M(2, 3)) * invdet + Minv(3, 1) = (M(2, 1) * M(3, 2) - M(3, 1) * M(2, 2)) * invdet + Minv(3, 2) = (M(3, 1) * M(1, 2) - M(1, 1) * M(3, 2)) * invdet + Minv(3, 3) = (M(1, 1) * M(2, 2) - M(2, 1) * M(1, 2)) * invdet + + END SUBROUTINE Inverse3by3 + !----------------------------------------------------------------------- + + + ! One-function implementation of Crout LU Decomposition. Solves Ax=b for x + SUBROUTINE LUsolve(n, A, LU, b, y, x) + + INTEGER(intKi), INTENT(IN ) :: n ! size of matrices and vectors + Real(DbKi), INTENT(IN ) :: A( n,n) ! LHS matrix (e.g. mass matrix) + Real(DbKi), INTENT(INOUT) :: LU(n,n) ! stores LU matrix data + Real(DbKi), INTENT(IN ) :: b(n) ! RHS vector + Real(DbKi), INTENT(INOUT) :: y(n) ! temporary vector + Real(DbKi), INTENT( OUT) :: x(n) ! LHS vector to solve for + + INTEGER(intKi) :: i,j,k,p + Real(DbKi) :: sum + + DO k = 1,n + DO i = k,n + + sum = 0.0_DbKi + + DO p=1,k-1 !for(int p=0; p=0; --i) + + sum = 0.0_DbKi + + DO k=i+1, n + sum = sum + LU(i,k)*x(k) + END DO + + x(i) = (y(i)-sum) + + END DO !j (actually decrementing i) + + END SUBROUTINE LUsolve + + + + ! :::::::::::::::::::::::::: interpolation subroutines ::::::::::::::::::::::::::::::: + + + SUBROUTINE getInterpNums(xlist, xin, istart, i, fout) + + Real(DbKi), INTENT (IN ) :: xlist(:) ! list of x values + Real(DbKi), INTENT (IN ) :: xin ! x value to be interpolated + Integer(IntKi),INTENT (IN ) :: istart ! first lower index to try + Integer(IntKi),INTENT ( OUT) :: i ! lower index to interpolate from + Real(DbKi), INTENT ( OUT) :: fout ! fraction to return such that y* = y[i] + fout*(y[i+1]-y[i]) + + Integer(IntKi) :: i1 + Integer(IntKi) :: nx + + i1 = 1 ! Setting in declaration causes an implied save, which would never allow this routine to find anything at the start of the array. + + nx = SIZE(xlist) + + if (xin <= xlist(1)) THEN ! below lowest data point + i = 1_IntKi + fout = 0.0_DbKi + + else if (xlist(nx) <= xin) THEN ! above highest data point + i = nx + fout = 0.0_DbKi + + else ! within the data range + + IF (xlist(min(istart,nx)) < xin) i1 = istart ! if istart is below the actual value, start with it instead of starting at 1 to save time, but make sure it doesn't overstep the array + + DO i = i1, nx-1 + IF (xlist(i+1) > xin) THEN + fout = (xin - xlist(i) )/( xlist(i+1) - xlist(i) ) + exit + END IF + END DO + END IF + + END SUBROUTINE getInterpNums + + + SUBROUTINE getInterpNumsSiKi(xlist, xin, istart, i, fout) + + Real(SiKi), INTENT (IN ) :: xlist(:) ! list of x values + Real(SiKi), INTENT (IN ) :: xin ! x value to be interpolated + Integer(IntKi),INTENT (IN ) :: istart ! first lower index to try + Integer(IntKi),INTENT ( OUT) :: i ! lower index to interpolate from + Real(SiKi), INTENT ( OUT) :: fout ! fraction to return such that y* = y[i] + fout*(y[i+1]-y[i]) + + Integer(IntKi) :: i1 + Integer(IntKi) :: nx + + i1 = 1 ! Setting in declaration causes an implied save, which would never allow this routine to find anything at the start of the array. + + nx = SIZE(xlist) + + if (xin <= xlist(1)) THEN ! below lowest data point + i = 1_IntKi + fout = 0.0_SiKi + + else if (xlist(nx) <= xin) THEN ! above highest data point + i = nx + fout = 0.0_SiKi + + else ! within the data range + + IF (xlist(min(istart,nx)) < xin) i1 = istart ! if istart is below the actual value, start with it instead of starting at 1 to save time, but make sure it doesn't overstep the array + + DO i = i1, nx-1 + IF (xlist(i+1) > xin) THEN + fout = (xin - xlist(i) )/( xlist(i+1) - xlist(i) ) + exit + END IF + END DO + END IF + + END SUBROUTINE getInterpNumsSiKi + + SUBROUTINE calculate4Dinterpolation(f, ix0, iy0, iz0, it0, fx, fy, fz, ft, c) + + Real(SiKi), INTENT (IN ) :: f(:,:,:,:) ! data array + INTEGER(IntKi), INTENT (IN ) :: ix0, iy0, iz0, it0 ! indices for interpolation + Real(SiKi), INTENT (IN ) :: fx, fy, fz, ft ! interpolation fractions + Real(DbKi), INTENT ( OUT) :: c ! the output value + + INTEGER(IntKi) :: ix1, iy1, iz1, it1 ! second indices + REAL(SiKi) :: c000, c001, c010, c011, c100, c101, c110, c111 + REAL(SiKi) :: c00, c01, c10, c11, c0, c1 + + ! handle end case conditions + if (fx == 0) then + ix1 = ix0 + else + ix1 = min(ix0+1,size(f,4)) ! don't overstep bounds + end if + + if (fy == 0) then + iy1 = iy0 + else + iy1 = min(iy0+1,size(f,3)) ! don't overstep bounds + end if + + if (fz == 0) then + iz1 = iz0 + else + iz1 = min(iz0+1,size(f,2)) ! don't overstep bounds + end if + + if (ft == 0) then + it1 = it0 + else + it1 = min(it0+1,size(f,1)) ! don't overstep bounds + end if + + c000 = f(it0,iz0,iy0,ix0)*(1.0-ft) + f(it1,iz0,iy0,ix0)*ft + c001 = f(it0,iz1,iy0,ix0)*(1.0-ft) + f(it1,iz1,iy0,ix0)*ft + c010 = f(it0,iz0,iy1,ix0)*(1.0-ft) + f(it1,iz0,iy1,ix0)*ft + c011 = f(it0,iz1,iy1,ix0)*(1.0-ft) + f(it1,iz1,iy1,ix0)*ft + c100 = f(it0,iz0,iy0,ix1)*(1.0-ft) + f(it1,iz0,iy0,ix1)*ft + c101 = f(it0,iz1,iy0,ix1)*(1.0-ft) + f(it1,iz1,iy0,ix1)*ft + c110 = f(it0,iz0,iy1,ix1)*(1.0-ft) + f(it1,iz0,iy1,ix1)*ft + c111 = f(it0,iz1,iy1,ix1)*(1.0-ft) + f(it1,iz1,iy1,ix1)*ft + + c00 = c000*(1.0-fx) + c100*fx + c01 = c001*(1.0-fx) + c101*fx + c10 = c010*(1.0-fx) + c110*fx + c11 = c011*(1.0-fx) + c111*fx + + c0 = c00 *(1.0-fy) + c10 *fy + c1 = c01 *(1.0-fy) + c11 *fy + + c = c0 *(1.0-fz) + c1 *fz + + END SUBROUTINE + + + SUBROUTINE calculate3Dinterpolation(f, ix0, iy0, iz0, fx, fy, fz, c) + + Real(SiKi), INTENT (IN ) :: f(:,:,:) ! data array + INTEGER(IntKi), INTENT (IN ) :: ix0, iy0, iz0 ! indices for interpolation + Real(SiKi), INTENT (IN ) :: fx, fy, fz ! interpolation fractions + Real(DbKi), INTENT ( OUT) :: c ! the output value + + INTEGER(IntKi) :: ix1, iy1, iz1 ! second indices + REAL(SiKi) :: c000, c001, c010, c011, c100, c101, c110, c111 + REAL(SiKi) :: c00, c01, c10, c11, c0, c1 + + ! note that "z" could also be "t" - dimension names are arbitrary + + ! handle end case conditions + if (fx == 0) then + ix1 = ix0 + else + ix1 = min(ix0+1,size(f,3)) ! don't overstep bounds + end if + + if (fy == 0) then + iy1 = iy0 + else + iy1 = min(iy0+1,size(f,2)) ! don't overstep bounds + end if + + if (fz == 0) then + iz1 = iz0 + else + iz1 = min(iz0+1,size(f,1)) ! don't overstep bounds + end if + + c000 = f(iz0,iy0,ix0) + c001 = f(iz1,iy0,ix0) + c010 = f(iz0,iy1,ix0) + c011 = f(iz1,iy1,ix0) + c100 = f(iz0,iy0,ix1) + c101 = f(iz1,iy0,ix1) + c110 = f(iz0,iy1,ix1) + c111 = f(iz1,iy1,ix1) + + c00 = c000*(1.0-fx) + c100*fx + c01 = c001*(1.0-fx) + c101*fx + c10 = c010*(1.0-fx) + c110*fx + c11 = c011*(1.0-fx) + c111*fx + + c0 = c00 *(1.0-fy) + c10 *fy + c1 = c01 *(1.0-fy) + c11 *fy + + c = c0 *(1.0-fz) + c1 *fz + + END SUBROUTINE + + SUBROUTINE calculate2Dinterpolation(f, ix0, iy0, fx, fy, c) + REAL(DbKi), INTENT (IN ) :: f(:,:) ! data array + INTEGER(IntKi), INTENT (IN ) :: ix0, iy0 ! indices for interpolation + REAL(DbKi), INTENT (IN ) :: fx, fy ! interpolation fractions + REAL(DbKi), INTENT ( OUT) :: c ! the output value + + INTEGER(IntKi) :: ix1, iy1 ! second indices + REAL(DbKi) :: c00, c01, c10, c11, c0, c1 + + ! handle end case conditions + IF (fx == 0) THEN + ix1 = ix0 + ELSE + ix1 = min(ix0+1,size(f,2)) ! don't overstep bounds + END IF + IF (fy == 0) THEN + iy1 = iy0 + ELSE + iy1 = min(iy0+1,size(f,1)) ! don't overstep bounds + END IF + c00 = f(iy0, ix0) + c01 = f(iy1, ix0) + c10 = f(iy0, ix1) + c11 = f(iy1, ix1) + c0 = c00 *(1.0-fx) + c10 *fx + c1 = c01 *(1.0-fx) + c11 *fx + c = c0 *(1.0-fy) + c1 *fy + END SUBROUTINE calculate2Dinterpolation + + + SUBROUTINE calculate1Dinterpolation(f, ix0, fx, c) + REAL(DbKi), INTENT (IN ) :: f(:) ! data array + INTEGER(IntKi), INTENT (IN ) :: ix0 ! indices for interpolation + REAL(DbKi), INTENT (IN ) :: fx ! interpolation fractions + REAL(DbKi), INTENT ( OUT) :: c ! the output value + + INTEGER(IntKi) :: ix1 ! second index + REAL(DbKi) :: c0, c1 + + ! handle end case conditions + IF (fx == 0) THEN + ix1 = ix0 + ELSE + ix1 = min(ix0+1,size(f,1)) ! don't overstep bounds + END IF + + c0 = f(ix0) + c1 = f(ix1) + c = c0*(1.0-fx) + c1*fx + END SUBROUTINE calculate1Dinterpolation + + + + + ! :::::::::::::::::::::::::: bathymetry subroutines ::::::::::::::::::::::::::::::: + + ! interpolates local seabed depth and normal vector + SUBROUTINE getDepthFromBathymetry(BathymetryGrid, BathGrid_Xs, BathGrid_Ys, LineX, LineY, depth, nvec) + + REAL(DbKi), INTENT(IN ) :: BathymetryGrid(:,:) ! need colons or some sort of dimension setting + REAL(DbKi), INTENT(IN ) :: BathGrid_Xs(:) + REAL(DbKi), INTENT(IN ) :: BathGrid_Ys(:) + REAL(DbKi), INTENT(IN ) :: LineX + REAL(DbKi), INTENT(IN ) :: LineY + REAL(DbKi), INTENT( OUT) :: depth ! local seabed depth (positive down) [m] + REAL(DbKi), INTENT( OUT) :: nvec(3) ! local seabed surface normal vector (positive out) + + INTEGER(IntKi) :: ix0, iy0 ! indeces for interpolation + INTEGER(IntKi) :: ix1, iy1 ! second indices + Real(DbKi) :: fx, fy ! interpolation fractions + REAL(DbKi) :: c00, c01, c10, c11, cx0, cx1, c0y, c1y ! temporary depth values + Real(DbKi) :: dx, dy ! x and y spacing of local grid panel [m] + Real(DbKi) :: dc_dx, dc_dy ! local slope + Real(DbKi) :: tempVector(3) ! normal vector before scaling to unit + + ! get interpolation indices and fractions for the relevant grid panel + CALL getInterpNums(BathGrid_Xs, LineX, 1, ix0, fx) + CALL getInterpNums(BathGrid_Ys, LineY, 1, iy0, fy) + + !CALL calculate2Dinterpolation(BathymetryGrid, ix, iy, fx, fy, depth) + + ! handle end case conditions + IF (fx == 0) THEN + ix1 = ix0 + ELSE + ix1 = min(ix0+1,size(BathymetryGrid,2)) ! don't overstep bounds + END IF + IF (fy == 0) THEN + iy1 = iy0 + ELSE + iy1 = min(iy0+1,size(BathymetryGrid,1)) ! don't overstep bounds + END IF + + ! get corner points of the panel + c00 = BathymetryGrid(iy0, ix0) + c01 = BathymetryGrid(iy1, ix0) + c10 = BathymetryGrid(iy0, ix1) + c11 = BathymetryGrid(iy1, ix1) + + ! get interpolated points and local value + cx0 = c00 *(1.0-fx) + c10 *fx + cx1 = c01 *(1.0-fx) + c11 *fx + c0y = c00 *(1.0-fy) + c01 *fy + c1y = c10 *(1.0-fy) + c11 *fy + depth = cx0 *(1.0-fy) + cx1 *fy + + ! get local slope + dx = BathGrid_Xs(ix1) - BathGrid_Xs(ix0) + dy = BathGrid_Ys(iy1) - BathGrid_Ys(iy0) + if ( dx > 0.0 ) then + dc_dx = (c1y-c0y)/dx + else + dc_dx = 0.0_DbKi ! maybe this should raise an error + end if + if ( dx > 0.0 ) then + dc_dy = (cx1-cx0)/dy + else + dc_dy = 0.0_DbKi ! maybe this should raise an error + end if + + tempVector(1) = dc_dx + tempVector(2) = dc_dy + tempVector(3) = 1.0_DbKi + CALL ScaleVector( tempVector, 1.0_DbKi, nvec ) ! compute unit vector + + END SUBROUTINE getDepthFromBathymetry + + + ! :::::::::::::::::::::::::: wave and current subroutines ::::::::::::::::::::::::::::::: + + + ! master function to get wave/water kinematics at a given point -- called by each object from grid-based data + SUBROUTINE getWaterKin(p, x, y, z, t, tindex, U, Ud, zeta, PDyn) + + ! This whole approach assuems that px, py, and pz are in increasing order. + ! Wheeler stretching is now built in. + + TYPE(MD_ParameterType),INTENT (IN ) :: p ! MoorDyn parameters (contains the wave info for now) + Real(DbKi), INTENT (IN ) :: x + Real(DbKi), INTENT (IN ) :: y + Real(DbKi), INTENT (IN ) :: z + Real(DbKi), INTENT (IN ) :: t + INTEGER(IntKi), INTENT (INOUT) :: tindex ! pass time index to try starting from, returns identified time index + Real(DbKi), INTENT (INOUT) :: U(3) + Real(DbKi), INTENT (INOUT) :: Ud(3) + Real(DbKi), INTENT (INOUT) :: zeta + Real(DbKi), INTENT (INOUT) :: 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 + Real(SiKi) :: fx, fy, fz, ft ! interpolation fractions + Real(DbKi) :: zp ! zprime coordinate used for Wheeler stretching + + + ! if wave kinematics enabled, get interpolated values from grid + if (p%WaveKin > 0) then + + ! find time interpolation indices and coefficients + !CALL getInterpNums(p%tWave, t, tindex, it, ft) + it = floor(t/ p%dtWave) + 1 ! add 1 because Fortran indexing starts at 1 + ft = (t - (it-1)*p%dtWave)/p%dtWave + tindex = it + + ! find x-y interpolation indices and coefficients + CALL getInterpNumsSiKi(p%pxWave , REAL(x,SiKi), 1, ix, fx) + CALL getInterpNumsSiKi(p%pyWave , REAL(y,SiKi), 1, iy, fy) + + ! interpolate wave elevation + CALL calculate3Dinterpolation(p%zeta, ix, iy, it, fx, fy, ft, zeta) + + ! compute modified z coordinate to be used for interpolating velocities and accelerations with Wheeler stretching + zp = ( z - zeta ) * p%WtrDpth/( p%WtrDpth + zeta ) + + CALL getInterpNumsSiKi(p%pzWave , REAL(zp,SiKi), 1, iz, fz) + + ! interpolate everything else + CALL calculate4Dinterpolation(p%PDyn , ix, iy, iz, it, fx, fy, fz, ft, PDyn) + CALL calculate4Dinterpolation(p%uxWave, ix, iy, iz, it, fx, fy, fz, ft, U(1) ) + CALL calculate4Dinterpolation(p%uyWave, ix, iy, iz, it, fx, fy, fz, ft, U(2) ) + CALL calculate4Dinterpolation(p%uzWave, ix, iy, iz, it, fx, fy, fz, ft, U(3) ) + CALL calculate4Dinterpolation(p%axWave, ix, iy, iz, it, fx, fy, fz, ft, Ud(1) ) + CALL calculate4Dinterpolation(p%ayWave, ix, iy, iz, it, fx, fy, fz, ft, Ud(2) ) + CALL calculate4Dinterpolation(p%azWave, ix, iy, iz, it, fx, fy, fz, ft, Ud(3) ) + else + U = 0.0_DbKi + Ud = 0.0_DbKi + zeta = 0.0_DbKi + PDyn = 0.0_DbKi + end if + + + ! if current kinematics enabled, add interpolated current values from profile + if (p%Current > 0) then + + CALL getInterpNumsSiKi(p%pzCurrent, REAL(z,SiKi), 1, iz0, fz) + + IF (fz == 0) THEN ! handle end case conditions + iz1 = iz0 + ELSE + iz1 = min(iz0+1,size(p%pzCurrent)) ! don't overstep bounds + END IF + + U(1) = U(1) + (1.0-fz)*p%uxCurrent(iz0) + fz*p%uxCurrent(iz1) + U(2) = U(2) + (1.0-fz)*p%uyCurrent(iz0) + fz*p%uyCurrent(iz1) + end if + + 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%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 ----- + SUBROUTINE WriteWaveGrid(p, ErrStat, ErrMsg) + + TYPE(MD_ParameterType), INTENT(INOUT) :: p ! Parameters + + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(120) :: ErrMsg2 + + CHARACTER(120) :: Frmt + INTEGER(IntKi) :: UnOut ! for outputing wave kinematics data + INTEGER(IntKi) :: I + + + CALL GetNewUnit( UnOut) + + CALL OpenFOutFile ( UnOut, "waves.txt", ErrStat, ErrMsg ) + IF ( ErrStat > ErrID_None ) THEN + ErrMsg = ' Error opening wave grid file: '//TRIM(ErrMsg) + ErrStat = ErrID_Fatal + RETURN + END IF + + WRITE(UnOut, *, IOSTAT=ErrStat2) TRIM( 'MoorDyn v2 wave/current kinematics grid file' ) + WRITE(UnOut, *, IOSTAT=ErrStat2) TRIM( '---------------------------------------------' ) + WRITE(UnOut, *, IOSTAT=ErrStat2) TRIM( 'The following 6 lines (4-9) specify the input type then the inputs for x, then, y, then z coordinates.' ) + + WRITE(UnOut,*, IOSTAT=ErrStat2) TRIM( '1 - X input type (0: not used; 1: list values in ascending order; 2: uniform specified by -xlim, xlim, num)' ) + Frmt = '('//TRIM(Int2LStr(5))//'(A1,e10.4))' + WRITE(UnOut,*, IOSTAT=ErrStat2) ( " ", TRIM(Num2LStr(p%pxWave(I))), I=1,p%nxWave ) + + WRITE(UnOut,*, IOSTAT=ErrStat2) TRIM( '1 - Y input type (0: not used; 1: list values in ascending order; 2: uniform specified by -xlim, xlim, num)' ) + Frmt = '('//TRIM(Int2LStr(5))//'(A1,e10.4))' + WRITE(UnOut,*, IOSTAT=ErrStat2) ( " ", TRIM(Num2LStr(p%pyWave(I))), I=1,p%nyWave ) + + WRITE(UnOut,*, IOSTAT=ErrStat2) TRIM( '1 - Z input type (0: not used; 1: list values in ascending order; 2: uniform specified by -xlim, xlim, num)' ) + 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 + ErrMsg = 'Error closing wave grid file' + END IF + + END SUBROUTINE WriteWaveGrid + + + ! ----- write wave kinematics grid data to output file ----- + SUBROUTINE WriteWaveData(p, ErrStat, ErrMsg) + + TYPE(MD_ParameterType), INTENT(INOUT) :: p ! Parameters + + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(120) :: ErrMsg2 + + INTEGER(IntKi) :: UnOut ! for outputing wave kinematics data + INTEGER(IntKi) :: I,J,K, l, Itemp + + CALL GetNewUnit( UnOut) + + CALL OpenFOutFile ( UnOut, "wave data.txt", ErrStat, ErrMsg ) + IF ( ErrStat > ErrID_None ) THEN + ErrMsg = ' Error opening wave grid file: '//TRIM(ErrMsg) + ErrStat = ErrID_Fatal + RETURN + END IF + + ! write channel labels + + + ! time + WRITE(UnOut,"(A10)", IOSTAT=ErrStat2, advance="no") "Time" + + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " ze0", Num2Lstr(J+10*K) + END DO + END DO + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " ux", Num2Lstr(I+10*J+100*K) + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " uy", Num2Lstr(I+10*J+100*K) + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " uz", Num2Lstr(I+10*J+100*K) + END DO + END DO + END DO + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " ax", Num2Lstr(I+10*J+100*K) + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " ay", Num2Lstr(I+10*J+100*K) + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " az", Num2Lstr(I+10*J+100*K) + END DO + END DO + END DO + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " pd", Num2Lstr(I+10*J+100*K) + END DO + END DO + END DO + + ! end the line + WRITE(UnOut, "(A1)", IOSTAT=ErrStat2) " " + + + + DO l=1, p%ntWave ! loop through all time steps + + ! time + WRITE(UnOut,"(F10.4)", IOSTAT=ErrStat2, advance="no") p%dtWave*(l-1) + !WRITE(UnOut,"(F10.4)", IOSTAT=ErrStat2, advance="no") InitInp%WaveTime(l) + + ! wave elevation (all slices for now, to check) + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + Itemp = (J-1)*p%nxWave + K ! index of actual node + + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%zeta(l,J,K) + END DO + END DO + + ! wave velocities + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + Itemp = (I-1)*p%nxWave*p%nyWave + (J-1)*p%nxWave + K ! index of actual node + + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%uxWave(l,I,J,K) + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%uyWave(l,I,J,K) + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%uzWave(l,I,J,K) + END DO + END DO + END DO + + ! wave accelerations + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + Itemp = (I-1)*p%nxWave*p%nyWave + (J-1)*p%nxWave + K ! index of actual node + + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%axWave(l,I,J,K) + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%ayWave(l,I,J,K) + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%azWave(l,I,J,K) + END DO + END DO + END DO + + ! dynamic pressure + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + Itemp = (I-1)*p%nxWave*p%nyWave + (J-1)*p%nxWave + K ! index of actual node + + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%PDyn(l,I,J,K) + END DO + END DO + END DO + + ! end the line + WRITE(UnOut, "(A1)", IOSTAT=ErrStat2) " " + + + END DO + + + CLOSE(UnOut, IOSTAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrMsg = 'Error closing wave grid file' + END IF + + END SUBROUTINE WriteWaveData + + + ! ----- process WaterKin input value, potentially reading wave inputs and generating wave field ----- + SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) + + CHARACTER(40), INTENT(IN ) :: WaterKinString ! string describing water kinematics filename + TYPE(MD_ParameterType), INTENT(INOUT) :: p ! Parameters + REAL(ReKi), INTENT(IN ) :: Tmax + 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) :: ntIn ! number of time series inputs from file + INTEGER(IntKi) :: UnIn ! unit number for coefficient input file + INTEGER(IntKi) :: UnEcho + REAL(SiKi) :: pzCurrentTemp(100) ! current depth increments read in from input file (positive-down at this stage) + REAL(SiKi) :: uxCurrentTemp(100) + REAL(SiKi) :: uyCurrentTemp(100) + + CHARACTER(120) :: WaveKinFile + INTEGER(IntKi) :: UnElev ! unit number for coefficient input file + REAL(SiKi), ALLOCATABLE :: WaveTimeIn(:) ! temporarily holds wave input time series + REAL(SiKi), ALLOCATABLE :: WaveElevIn(:) + REAL(SiKi), ALLOCATABLE :: WaveElev0(:) ! interpolated reference wave elevation time series + REAL(SiKi) :: WaveDir + REAL(SiKi) :: t, Frac + CHARACTER(1024) :: FileName ! Name of MoorDyn input file + CHARACTER(120) :: Line + CHARACTER(120) :: Line2 + CHARACTER(120) :: entries2 + INTEGER(IntKi) :: coordtype + + INTEGER(IntKi) :: NStepWave ! + INTEGER(IntKi) :: NStepWave2 ! + REAL(SiKi) :: WaveTMax ! max wave elevation time series duration after optimizing lenght for FFT + REAL(SiKi) :: WaveDOmega + REAL(SiKi) :: SinWaveDir ! SIN( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction. + REAL(SiKi) :: CosWaveDir ! COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction. + + REAL(SiKi), ALLOCATABLE :: TmpFFTWaveElev(:) ! Data for the FFT calculation + TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using + + + COMPLEX(SiKi),ALLOCATABLE :: tmpComplex(:) ! A temporary array (0:NStepWave2-1) for FFT use. + + REAL(SiKi) :: Omega ! Wave frequency (rad/s) + COMPLEX(SiKi), PARAMETER :: ImagNmbr = (0.0,1.0) ! The imaginary number, SQRT(-1.0) + COMPLEX(SiKi) :: ImagOmega ! = ImagNmbr*Omega (rad/s) + REAL(DbKi), ALLOCATABLE :: WaveNmbr(:) ! wave number for frequency array + REAL(SiKi), ALLOCATABLE :: WaveElevC0(:,:) ! Discrete Fourier transform of the instantaneous elevation of incident waves at the ref point (meters) + COMPLEX(SiKi), ALLOCATABLE :: WaveElevC( :) ! Discrete Fourier transform of the instantaneous elevation of incident waves at the ref point (meters) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccCHx(:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccCHy(:) ! 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 :: WaveAccCV( :) ! 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 :: WaveDynPC( :) ! 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 :: 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 (-) + + INTEGER(IntKi) :: ErrStatTmp + INTEGER(IntKi) :: ErrStat2 + CHARACTER(120) :: ErrMsg2 + CHARACTER(120) :: RoutineName = 'SetupWaveKin' + + + ErrStatTmp = ErrID_None ! TODO: get rid of redundancy <<< + ErrStat2 = ErrID_None + ErrMsg2 = "" + + IF (LEN_TRIM(WaterKinString) == 0) THEN + ! If the input is empty (not provided), there are no water kinematics to be included + p%WaveKin = 0 + p%Current = 0 + return + + 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." + p%WaveKin = 0 + p%Current = 0 + return + END IF + + + ! 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" + + + ! -------- load water kinematics input file ------------- + + IF ( PathIsRelative( WaterKinString ) ) THEN ! properly handle relative path <<< + !CALL GetPath( TRIM(InitInp%InputFile), TmpPath ) + FileName = TRIM(p%PriPath)//TRIM(WaterKinString) + ELSE + FileName = trim(WaterKinString) + END IF + + + + UnEcho=-1 + CALL GetNewUnit( UnIn ) + CALL OpenFInpFile( UnIn, FileName, ErrStat2, ErrMsg2); if(Failed()) return + + + CALL ReadCom( UnIn, FileName, 'MoorDyn water kinematics input file header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadCom( UnIn, FileName, 'MoorDyn water kinematics input file header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + ! ----- waves ----- + CALL ReadCom( UnIn, FileName, 'waves header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadVar( UnIn, FileName, p%WaveKin , 'WaveKinMod' , 'WaveKinMod' , ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadVar( UnIn, FileName, WaveKinFile, 'WaveKinFile', 'WaveKinFile' , ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadVar( UnIn, FileName, p%dtWave , 'dtWave', 'time step for waves', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadVar( UnIn, FileName, WaveDir , 'WaveDir' , 'wave direction', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + ! X 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%pxWave, p%nxWave, ErrStat2, ErrMsg2) + ! 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) + ! 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) + ! ----- 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 + CALL ReadCom( UnIn, FileName, 'current profile header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadCom( UnIn, FileName, 'current profile header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + ! current profile table... (read through to end of file or ---) + DO I=1,100 + READ(UnIn, *, IOSTAT=ErrStat2) pzCurrentTemp(i), uxCurrentTemp(i), uyCurrentTemp(i) ! read into a line + if (ErrStat2 /= 0) then + p%nzCurrent = i-1 ! save number of valid current depth points in profile + 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" + exit + end if + END DO + + + CLOSE(UnIn) + + + ! ------------------- start with wave kinematics ----------------------- + + ! WaveKin options: 0 - none or set externally during the sim (Waves object not needed unless there's current) [default] + ! 1 - set externally for each node in each object (Waves object not needed unless there's current) (TBD) + ! 2 - set from inputted wave elevation FFT, grid approach* (TBD) + ! 3 - set from inputted wave elevation time series, grid approach* [supported] + ! 4 - set from inputted wave elevation FFT, node approach (TBD) + ! 5 - set from inputted wave elevation time series, node approach (TBD) + ! 6 - set from inputted velocity, acceleration, and wave elevation grid data (TBD)** + + ! Current options: 0 - no currents or set externally (as part of WaveKin =0 or 1 approach) [default] + ! 1 - read in steady current profile, grid approach (current_profile.txt)** [supported] + ! 2 - read in dynamic current profile, grid approach (current_profile_dynamic.txt)** (TBD) + ! 3 - read in steady current profile, node approach (current_profile.txt) (TBD) + ! 4 - read in dynamic current profile, node approach (current_profile_dynamic.txt) (TBD) + + ! * the first call to any of these will attempt to load water_grid.txt to define the grid to put things on + ! ** if a grid has already been set, these will interpolate onto it, otherwise they'll make a new grid based on their provided coordinates + + ! NOTE: lots of partial code is available from MD-C for supporting various wave kinematics input options + + ! WaveKin and Current compatibility check could go here in future + + + ! --------------------- 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' + + IF ( LEN_TRIM( WaveKinFile ) == 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'WaveKinFile must not be an empty string.',ErrStat, ErrMsg, RoutineName); return + RETURN + END IF + + IF ( PathIsRelative( WaveKinFile ) ) THEN ! properly handle relative path <<< + !CALL GetPath( TRIM(InitInp%InputFile), TmpPath ) + WaveKinFile = TRIM(p%PriPath)//TRIM(WaveKinFile) + END IF + + ! note: following is adapted from MoorDyn_Driver + + CALL GetNewUnit( UnElev ) + + CALL OpenFInpFile ( UnElev, WaveKinFile, ErrStat2, ErrMsg2 ); if(Failed()) return + + print *, 'Reading wave elevation data from ', trim(WaveKinFile) + + ! Read through length of file to find its length + i = 1 ! start counter + 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 + 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 + + + ! allocate space for input wave elevation array (including time column) + CALL AllocAry(WaveTimeIn, ntIn, 'WaveTimeIn', ErrStat2, ErrMsg2 ); if(Failed()) return + 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, ntIn + READ (UnElev, *, IOSTAT=ErrStat2) WaveTimeIn(i), WaveElevIn(i) + + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'Error reading WaveElev input file.',ErrStat, ErrMsg, RoutineName); return + END IF + END DO + + ! Close the inputs file + CLOSE ( UnElev ) + + print *, "Read ", ntIn, " time steps from input file." + + ! if (WaveTimeIn(ntIn) < TMax) then <<<< need to handle if time series is too short? + + ! specify stepping details + p%ntWave = CEILING(Tmax/p%dtWave) ! number of wave time steps + + + ! allocate space for processed reference wave elevation time series + ALLOCATE ( WaveElev0( 0:p%ntWave ), STAT=ErrStatTmp ) ! this has an extra entry of zero in case it needs to be padded to be even + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveElev0.',ErrStat,ErrMsg,RoutineName) + WaveElev0 = 0.0_SiKi + + ! go through and interpolate (should replace with standard function) + DO i = 1, p%ntWave + t = p%dtWave*(i-1) + + ! interpolation routine + DO iIn = 1,ntIn-1 + IF (WaveTimeIn(iIn+1) > t) THEN ! find the right two points to interpolate between (remember that the first column of PtfmMotIn is time) + frac = (t - WaveTimeIn(iIn) )/( WaveTimeIn(iIn+1) - WaveTimeIn(iIn) ) ! interpolation fraction (0-1) between two interpolation points + WaveElev0(i-1) = WaveElevIn(iIn) + frac*(WaveElevIn(iIn+1) - WaveElevIn(iIn)) ! get interpolated wave elevation + EXIT ! break out of the loop for this time step once we've done its interpolation + END IF + END DO + END DO + + ! note: following is adapted from UserWaves.v90 UserWaveElevations_Init + + + + ! 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 + + IF ( MOD(p%ntWave,2) == 1 ) p%ntWave = p%ntWave + 1 ! Set NStepWave to an even integer + NStepWave2 = MAX( p%ntWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is + NStepWave = 2*PSF ( NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. + NStepWave2 = NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. + WaveTMax = NStepWave*p%dtWave ! Update the value of WaveTMax based on the value needed for NStepWave. + WaveDOmega = TwoPi/TMax ! Compute the frequency step for incident wave calculations. + p%ntWave = NStepWave + + + + + ! Allocate array to hold the wave elevations for calculation of FFT. + ALLOCATE ( TmpFFTWaveElev( 0: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 ( WaveElevC0(2, 0:NStepWave2 ), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array 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_DbKi + WaveElevC0(:,:) = 0.0_DbKi + + + ! Copy values over + DO I=0, MIN(SIZE(WaveElev0), NStepWave)-1 + TmpFFTWaveElev(I) = WaveElev0(I) + ENDDO + + ! Initialize the FFT + CALL InitFFT ( NStepWave, FFT_Data, .FALSE., ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName); if(Failed()) return + + ! 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(Failed()) return + + ! Copy the resulting TmpFFTWaveElev(:) data over to the WaveElevC0 array + DO I=1,NStepWave2-1 + WaveElevC0 (1,I) = TmpFFTWaveElev(2*I-1) + WaveElevC0 (2,I) = TmpFFTWaveElev(2*I) + ENDDO + WaveElevC0(:,NStepWave2) = 0.0_SiKi + + CALL ExitFFT(FFT_Data, ErrStatTmp) + CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName); if(Failed()) return + + + IF (ALLOCATED( WaveElev0 )) DEALLOCATE( WaveElev0 , STAT=ErrStatTmp) + IF (ALLOCATED( TmpFFTWaveElev )) DEALLOCATE( TmpFFTWaveElev, STAT=ErrStatTmp) + + + + ! note: following is a very streamlined adaptation from from Waves.v90 VariousWaves_Init + + ! allocate all the wave kinematics FFT arrays + ALLOCATE( WaveNmbr (0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveNmbr. ',ErrStat,ErrMsg,RoutineName) + ALLOCATE( tmpComplex(0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate tmpComplex.',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveElevC (0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveElevC .',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveDynPC (0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveDynPC .',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveVelCHx(0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveVelCHx.',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveVelCHy(0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveVelCHy.',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveVelCV (0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveVelCV .',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveAccCHx(0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveAccCHx.',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveAccCHy(0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveAccCHy.',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveAccCV (0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveAccCV .',ErrStat,ErrMsg,RoutineName) + + ! allocate time series grid data arrays (now that we know the number of time steps coming from the IFFTs) + CALL allocateKinematicsArrays() + + + ! Set the CosWaveDir and SinWaveDir values + CosWaveDir=COS(D2R*WaveDir) + SinWaveDir=SIN(D2R*WaveDir) + + ! get wave number array once + DO I = 0, NStepWave2 + WaveNmbr(i) = WaveNumber ( dble(I*WaveDOmega), p%g, p%WtrDpth ) + tmpComplex(I) = CMPLX(WaveElevC0(1,I), WaveElevC0(2,I)) + END DO + + ! set up FFTer for doing IFFTs + CALL InitFFT ( NStepWave, FFT_Data, .TRUE., ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.', ErrStat, ErrMsg, routineName); if(Failed()) return + + ! Loop through all points where the incident wave kinematics will be computed + do ix = 1,p%nxWave + do iy = 1,p%nyWave + do iz = 1,p%nzWave + + ! Compute the discrete Fourier transform of the incident wave kinematics + do i = 0, NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + + Omega = i*WaveDOmega + ImagOmega = ImagNmbr*Omega + + WaveElevC (i) = tmpComplex(i) * EXP( -ImagNmbr*WaveNmbr(i)*( p%pxWave(ix)*CosWaveDir + p%pyWave(iy)*SinWaveDir )) + WaveDynPC (i) = p%rhoW*p%g* WaveElevC(i) * COSHNumOvrCOSHDen( WaveNmbr(i), p%WtrDpth, DBLE(p%pzWave(iz)) ) + WaveVelCHx(i) = Omega*WaveElevC(i) * COSHNumOvrSINHDen( WaveNmbr(i), p%WtrDpth, DBLE(p%pzWave(iz)) ) *CosWaveDir + WaveVelCHy(i) = Omega*WaveElevC(i) * COSHNumOvrSINHDen( WaveNmbr(i), p%WtrDpth, DBLE(p%pzWave(iz)) ) *SinWaveDir + WaveVelCV (i) = ImagOmega*WaveElevC(i) * SINHNumOvrSINHDen( WaveNmbr(i), p%WtrDpth, DBLE(p%pzWave(iz)) ) + WaveAccCHx(i) = ImagOmega*WaveVelCHx(i) + WaveAccCHy(i) = ImagOmega*WaveVelCHy(i) + WaveAccCV (i) = ImagOmega*WaveVelCV (i) + end do ! I, frequencies + + ! now IFFT all the wave kinematics except surface elevation and save it into the grid of data + CALL ApplyFFT_cx( p%PDyn (:,iz,iy,ix), WaveDynPC , FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveDynP.', ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%uxWave(:,iz,iy,ix), WaveVelCHx, FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveVelHx.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%uyWave(:,iz,iy,ix), WaveVelCHy, FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveVelHy.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%uzWave(:,iz,iy,ix), WaveVelCV , FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveVelV.', ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%axWave(:,iz,iy,ix), WaveAccCHx, FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveAccHx.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%ayWave(:,iz,iy,ix), WaveAccCHy, FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveAccHy.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%azWave(:,iz,iy,ix), WaveAccCV , FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveAccV.', ErrStat,ErrMsg,RoutineName) + + end do ! iz + + ! IFFT wave elevation here because it's only at the surface + CALL ApplyFFT_cx( p%zeta(:,iy,ix) , WaveElevC , FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveElev.', ErrStat,ErrMsg,RoutineName) + end do ! iy + end do ! ix + + ! could also reproduce the wave elevation at 0,0,0 on a separate channel for verification... + + CALL ExitFFT(FFT_Data, ErrStatTmp) + CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the IFFTs.', ErrStat,ErrMsg,RoutineName); if(Failed()) return + + end if ! p%WaveKin == 3 + + + ! --------------------------------- now do currents -------------------------------- + if (p%Current == 1) then + + ! allocate current profile arrays to correct size + CALL AllocAry( p%pzCurrent, p%nzCurrent, 'pzCurrent', ErrStat2, ErrMsg2 ); if(Failed()) return + CALL AllocAry( p%uxCurrent, p%nzCurrent, 'uxCurrent', ErrStat2, ErrMsg2 ); if(Failed()) return + CALL AllocAry( p%uyCurrent, p%nzCurrent, 'uyCurrent', ErrStat2, ErrMsg2 ); if(Failed()) return + + ! copy over data, flipping sign of depth values (to be positive-up) and reversing order + do i = 1,p%nzCurrent + p%pzCurrent(i) = -pzCurrentTemp(p%nzCurrent + 1 - i) ! flip sign so depth is positive-up + p%uxCurrent(i) = uxCurrentTemp(p%nzCurrent + 1 - i) + p%uyCurrent(i) = uyCurrentTemp(p%nzCurrent + 1 - i) + end do + + end if ! p%Current == 1 + + + ! ------------------------------ clean up and finished --------------------------- + CALL cleanup() + + + CONTAINS + + + ! get grid axis coordinates, initialize/record in array, and return size + SUBROUTINE gridAxisCoords(coordtype, entries, coordarray, n, ErrStat, ErrMsg) + + INTEGER(IntKi), INTENT(IN ) :: coordtype + CHARACTER(*), INTENT(INOUT) :: entries + REAL(SiKi), ALLOCATABLE, INTENT(INOUT) :: coordarray(:) + INTEGER(IntKi), INTENT( OUT) :: n + + + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + 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 + + END SUBROUTINE gridAxisCoords + + + ! Extract an array of numbers out of a string with comma-separated numbers (this could go in a more general location) + SUBROUTINE stringToArray(instring, n, outarray) + + CHARACTER(*), INTENT(INOUT) :: instring + INTEGER(IntKi), INTENT( OUT) :: n + REAL(ReKi), INTENT( OUT) :: outarray(100) ! array of output numbers (100 maximum) + + CHARACTER(40) :: tempstring + INTEGER :: pos1, pos2, i + + outarray = 0.0_ReKi + + n = 0 + pos1=1 + + DO + pos2 = INDEX(instring(pos1:), ",") ! find index of next comma + IF (pos2 == 0) THEN ! if there isn't another comma, read the last entry and call it done (this could be the only entry if no commas) + n = n + 1 + READ(instring(pos1:), *) outarray(n) + EXIT + END IF + n = n + 1 + if (n > 100) then + print *, "ERROR - stringToArray cannot do more than 100 entries" + end if + READ(instring(pos1:pos1+pos2-2), *) outarray(n) + + pos1 = pos2+pos1 + END DO + + END SUBROUTINE stringToArray + + + ! allocate water kinematics arrays + SUBROUTINE allocateKinematicsArrays() + ! error check print *, "Error in Waves::makeGrid, a time or space array is size zero." << endl; + + ALLOCATE ( p%uxWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%uyWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%uzWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%axWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%ayWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%azWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%PDyn ( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%zeta ( p%ntWave,p%nyWave,p%nxWave), STAT = ErrStatTmp ) ! 2D grid over x and y only + + END SUBROUTINE allocateKinematicsArrays + + + ! compact way to set the right error status and check if an abort is needed (and do cleanup if so) + LOGICAL FUNCTION Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetupWaterKin') + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + END FUNCTION Failed + + + SUBROUTINE CleanUp + + !IF (ALLOCATED( WaveElev )) DEALLOCATE( WaveElev, STAT=ErrStatTmp) + !IF (ALLOCATED( WaveTime )) DEALLOCATE( WaveTime, STAT=ErrStatTmp) + IF (ALLOCATED( TmpFFTWaveElev )) DEALLOCATE( TmpFFTWaveElev, STAT=ErrStatTmp) + IF (ALLOCATED( WaveElevC0 )) DEALLOCATE( WaveElevC0, STAT=ErrStatTmp) + + ! >>> missing some things <<< + + IF (ALLOCATED( WaveNmbr )) DEALLOCATE( WaveNmbr , STAT=ErrStatTmp) + IF (ALLOCATED( tmpComplex )) DEALLOCATE( tmpComplex , STAT=ErrStatTmp) + IF (ALLOCATED( WaveElevC )) DEALLOCATE( WaveElevC , STAT=ErrStatTmp) + IF (ALLOCATED( WaveDynPC )) DEALLOCATE( WaveDynPC , STAT=ErrStatTmp) + IF (ALLOCATED( WaveVelCHx )) DEALLOCATE( WaveVelCHx , STAT=ErrStatTmp) + IF (ALLOCATED( WaveVelCHy )) DEALLOCATE( WaveVelCHy , STAT=ErrStatTmp) + IF (ALLOCATED( WaveVelCV )) DEALLOCATE( WaveVelCV , STAT=ErrStatTmp) + IF (ALLOCATED( WaveAccCHx )) DEALLOCATE( WaveAccCHx , STAT=ErrStatTmp) + IF (ALLOCATED( WaveAccCHy )) DEALLOCATE( WaveAccCHy , STAT=ErrStatTmp) + IF (ALLOCATED( WaveAccCV )) DEALLOCATE( WaveAccCV , STAT=ErrStatTmp) + + END SUBROUTINE CleanUp + + + !======================================================================= + 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(DbKi), INTENT(IN ) :: g ! Gravitational acceleration (m/s^2) + REAL(DbKi), INTENT(IN ) :: h ! Water depth (meters) + REAL(DbKi), INTENT(IN ) :: Omega ! Wave frequency (rad/s) + REAL(DbKi) :: WaveNumber ! This function = wavenumber, k (1/m) + + + ! Local Variables: + + REAL(DbKi) :: A ! A temporary variable used in the solution. + REAL(DbKi) :: B ! A temporary variable used in the solution. + REAL(DbKi) :: C ! A temporary variable used in the solution. + REAL(DbKi) :: C2 ! A temporary variable used in the solution. + REAL(DbKi) :: CC ! A temporary variable used in the solution. + REAL(DbKi) :: E2 ! A temporary variable used in the solution. + REAL(DbKi) :: 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,DbKi) + 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(DbKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) + REAL(DbKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) + REAL(DbKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) + + + + ! Compute the hyperbolic numerator over denominator: + + IF ( k*h > 89.4_DbKi ) 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 = REAL(EXP( k*z ) + EXP( -k*( z + 2.0_DbKi*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(DbKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) + REAL(DbKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) + REAL(DbKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) + + + + ! Compute the hyperbolic numerator over denominator: + + + IF ( k < EPSILON(0.0_DbKi) ) THEN ! When .TRUE., the shallow water formulation is ill-conditioned; thus, HUGE(k) is returned to approximate the known value of infinity. + + COSHNumOvrSINHDen = 1.0E20 ! HUGE( k ) + + ELSEIF ( k*h > 89.4_DbKi ) 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(DbKi) :: COTH ! This function = COSH( X )/SINH( X ) (-) + REAL(DbKi), INTENT(IN ) :: X ! The argument (-) + + + + ! Compute the hyperbolic cotangent: + + IF ( X == 0.0_DbKi ) 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_DbKi/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(DbKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) + REAL(DbKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) + REAL(DbKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) + + + + ! Compute the hyperbolic numerator over denominator: + + IF ( k == 0.0_DbKi ) 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_DbKi ) 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_DbKi*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 + + END SUBROUTINE setupWaterKin + + + + + +END MODULE MoorDyn_Misc diff --git a/modules/moordyn/src/MoorDyn_Point.f90 b/modules/moordyn/src/MoorDyn_Point.f90 new file mode 100644 index 0000000000..fce8aab12f --- /dev/null +++ b/modules/moordyn/src/MoorDyn_Point.f90 @@ -0,0 +1,419 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall +! +! This file is part of MoorDyn. +! +! 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 MoorDyn_Point + + USE MoorDyn_Types + USE MoorDyn_IO + USE NWTC_Library + USE MoorDyn_Misc + USE MoorDyn_Line, only : Line_SetEndKinematics, Line_GetEndStuff + + IMPLICIT NONE + + PRIVATE + + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output + + PUBLIC :: Connect_Initialize + PUBLIC :: Connect_SetKinematics + PUBLIC :: Connect_SetState + PUBLIC :: Connect_GetStateDeriv + PUBLIC :: Connect_DoRHS + PUBLIC :: Connect_GetCoupledForce + PUBLIC :: Connect_GetNetForceAndMass + PUBLIC :: Connect_AddLine + PUBLIC :: Connect_RemoveLine + + +CONTAINS + + + !-------------------------------------------------------------- + SUBROUTINE Connect_Initialize(Connect, states, m) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connection object + Real(DbKi), INTENT(INOUT) :: states(6) ! state vector section for this Connection + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + INTEGER(IntKi) :: l + + + if (Connect%typeNum == 0) then ! error check + + ! pass kinematics to any attached lines so they have initial positions at this initialization stage + DO l=1,Connect%nAttached + IF (wordy > 1) print *, "Connect ", Connect%IdNum, " setting end kinematics of line ", Connect%attached(l), " to ", Connect%r + CALL Line_SetEndKinematics(m%LineList(Connect%attached(l)), Connect%r, Connect%rd, 0.0_DbKi, Connect%Top(l)) + END DO + + + ! assign initial node kinematics to state vector + states(4:6) = Connect%r + states(1:3) = Connect%rd + + + IF (wordy > 0) print *, "Initialized Connection ", Connect%IdNum + + else + CALL WrScr(" Error: wrong Point type given to Connect_Initialize for number "//trim(Int2Lstr(Connect%idNum))) + end if + + END SUBROUTINE Connect_Initialize + !-------------------------------------------------------------- + + + !-------------------------------------------------------------- + SUBROUTINE Connect_SetKinematics(Connect, r_in, rd_in, a_in, t, m) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connection object + Real(DbKi), INTENT(IN ) :: r_in( 3) ! position + Real(DbKi), INTENT(IN ) :: rd_in(3) ! velocity + Real(DbKi), INTENT(IN ) :: a_in(3) ! acceleration (only used for coupled connects) + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + + INTEGER(IntKi) :: l + + ! store current time + Connect%time = t + + + ! if (Connect%typeNum==0) THEN ! anchor ( <<< to be changed/expanded) ... in MoorDyn F also used for coupled connections + + ! set position and velocity + Connect%r = r_in + Connect%rd = rd_in + Connect%a = a_in + + ! pass latest kinematics to any attached lines + DO l=1,Connect%nAttached + CALL Line_SetEndKinematics(m%LineList(Connect%attached(l)), Connect%r, Connect%rd, t, Connect%Top(l)) + END DO + + ! else + ! + ! PRINT*,"Error: setKinematics called for wrong Connection type. Connection ", Connect%IdNum, " type ", Connect%typeNum + + ! END IF + + + END SUBROUTINE Connect_SetKinematics + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Connect_SetState(Connect, X, t, m) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connection object + Real(DbKi), INTENT(IN ) :: X(:) ! state vector section for this line + 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 + + + ! store current time + Connect%time = t + + ! from state values, get r and rdot values + DO J=1,3 + Connect%r( J) = X(3 + J) ! get positions + Connect%rd(J) = X( J) ! get velocities + END DO + + ! pass latest kinematics to any attached lines + DO l=1,Connect%nAttached + CALL Line_SetEndKinematics(m%LineList(Connect%attached(l)), Connect%r, Connect%rd, t, Connect%Top(l)) + END DO + + END SUBROUTINE Connect_SetState + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Connect_GetStateDeriv(Connect, Xd, m, p) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connection 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 + + !TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables + + !INTEGER(IntKi) :: l ! index of attached lines + INTEGER(IntKi) :: J ! index + INTEGER(IntKi) :: K ! index + Real(DbKi) :: Sum1 ! for adding things + + Real(DbKi) :: S(3,3) ! inverse mass matrix + + + CALL Connect_DoRHS(Connect, m, p) + +! // solve for accelerations in [M]{a}={f} using LU decomposition +! double M_tot[9]; // serialize total mass matrix for easy processing +! for (int I=0; I<3; I++) for (int J=0; J<3; J++) M_tot[3*I+J]=M[I][J]; +! double LU[9]; // serialized matrix that will hold LU matrices combined +! Crout(3, M_tot, LU); // perform LU decomposition on mass matrix +! double acc[3]; // acceleration vector to solve for +! solveCrout(3, LU, Fnet, acc); // solve for acceleration vector + + ! solve for accelerations in [M]{a}={f} using LU decomposition +! CALL LUsolve(6, M_out, LU_temp, Fnet_out, y_temp, acc) + + + ! invert node mass matrix + CALL Inverse3by3(S, Connect%M) + + ! accelerations + Connect%a = MATMUL(S, Connect%Fnet) + + ! fill in state derivatives + Xd(4:6) = Connect%rd ! dxdt = V (velocities) + Xd(1:3) = Connect%a ! dVdt = RHS * A (accelerations) + + + ! check for NaNs + DO J = 1, 6 + IF (Is_NaN(Xd(J))) THEN + CALL WrScr("NaN detected at time "//trim(Num2LStr(Connect%time))//" in Point "//trim(Int2LStr(Connect%IdNum))//" in MoorDyn.") + IF (wordy > 1) print *, "state derivatives:" + IF (wordy > 1) print *, Xd + EXIT + END IF + END DO + + END SUBROUTINE Connect_GetStateDeriv + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Connect_DoRHS(Connect, m, p) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connection object + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + !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) :: Fnet_i(3) ! force from an attached line + Real(DbKi) :: Moment_dummy(3) ! dummy vector to hold unused line end moments + Real(DbKi) :: M_i(3,3) ! mass from an attached line + + + ! start with the Connection's own forces including buoyancy and weight, and its own mass + Connect%Fnet(1) = Connect%conFX + Connect%Fnet(2) = Connect%conFY + Connect%Fnet(3) = Connect%conFZ + Connect%conV*p%rhoW*p%g - Connect%conM*p%g + + Connect%M = 0.0_DbKi ! clear (zero) the connect mass matrix + + DO J = 1,3 + Connect%M (J,J) = Connect%conM ! set the diagonals to the self-mass (to start with) + END DO + + + ! print *, "connection number", Connect%IdNum + ! print *, "attached lines: ", Connect%attached + ! print *, "size of line list" , size(m%LineList) + + ! loop through attached lines, adding force and mass contributions + DO l=1,Connect%nAttached + + ! print *, " l", l + ! print *, Connect%attached(l) + ! print *, m%LineList(Connect%attached(l))%Fnet + ! + ! + ! print *, " attached line ID", m%LineList(Connect%attached(l))%IdNum + + CALL Line_GetEndStuff(m%LineList(Connect%attached(l)), Fnet_i, Moment_dummy, M_i, Connect%Top(l)) + + ! sum quantitites + Connect%Fnet = Connect%Fnet + Fnet_i + Connect%M = Connect%M + M_i + + END DO + + + ! XXXWhen this sub is called, any self weight, buoyancy, or external forcing should have already been + ! added by the calling subroutine. The only thing left is any added mass or drag forces from the connection (e.g. float) + ! itself, which will be added below.XXX + + + ! IF (EqualRealNos(t, 0.0_DbKi)) THEN ! this is old: with current IC gen approach, we skip the first call to the line objects, because they're set AFTER the call to the connects + ! + ! DO J = 1,3 + ! Xd(3+J) = X(J) ! velocities - these are unused in integration + ! Xd(J) = 0.0_DbKi ! accelerations - these are unused in integration + ! END DO + ! ELSE + ! ! from state values, get r and rdot values + ! DO J = 1,3 + ! Connect%r(J) = X(3 + J) ! get positions + ! Connect%rd(J) = X(J) ! get velocities + ! END DO + ! END IF + + + ! add any added mass and drag forces from the Connect body itself + DO J = 1,3 + Connect%Fnet(J) = Connect%Fnet(J) - 0.5 * p%rhoW * Connect%rd(J) * abs(Connect%rd(J)) * Connect%conCdA; ! add drag forces - corrected Nov 24 + Connect%M (J,J) = Connect%M (J,J) + Connect%conV*p%rhoW*Connect%conCa; ! add added mass + + END DO + + ! would this sub ever need to include the m*a inertial term? Is it ever called for coupled connects? <<< + + END SUBROUTINE Connect_DoRHS + !===================================================================== + + + ! calculate the force including inertial loads on connect that is coupled + !-------------------------------------------------------------- + SUBROUTINE Connect_GetCoupledForce(Connect, Fnet_out, m, p) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connect object + Real(DbKi), INTENT( OUT) :: Fnet_out(3) ! force and moment vector about rRef + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + Real(DbKi) :: F_iner(3) ! inertial force + + IF (Connect%typeNum == -1) then + ! calculate forces and masses of connect + CALL Connect_DoRHS(Connect, m, p) + + ! add inertial loads as appropriate + F_iner = -MATMUL(Connect%M, Connect%a) ! inertial loads + Fnet_out = Connect%Fnet + F_iner ! add inertial loads + + ELSE + CALL WrScr("Connect_GetCoupledForce called for wrong (uncoupled) Point type in MoorDyn!") + END IF + + END SUBROUTINE Connect_GetCoupledForce + + + ! calculate the force and mass contributions of the connect on the parent body (only for type 3 connects?) + !-------------------------------------------------------------- + SUBROUTINE Connect_GetNetForceAndMass(Connect, rRef, Fnet_out, M_out, m, p) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connect object + Real(DbKi), INTENT(IN ) :: rRef(3) ! global coordinates 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 connection relative to the body reference point (global orientation frame) + + + CALL Connect_DoRHS(Connect, m, p) + + rRel = Connect%r - rRef ! vector from body reference point to node + + ! convert net force into 6dof force about body ref point + CALL translateForce3to6DOF(rRel, Connect%Fnet, Fnet_out) + + ! convert mass matrix to 6by6 mass matrix about body ref point + CALL translateMass3to6DOF(rRel, Connect%M, M_out) + + END SUBROUTINE Connect_GetNetForceAndMass + + + + + ! this function handles assigning a line to a connection node + !-------------------------------------------------------------- + SUBROUTINE Connect_AddLine(Connect, lineID, TopOfLine) + + Type(MD_Connect), INTENT (INOUT) :: Connect ! the Connection object + Integer(IntKi), INTENT( IN ) :: lineID + Integer(IntKi), INTENT( IN ) :: TopOfLine + + IF (wordy > 0) Print*, "L", lineID, "->C", Connect%IdNum + + IF (Connect%nAttached <10) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + Connect%nAttached = Connect%nAttached + 1 ! add the line to the number connected + Connect%Attached(Connect%nAttached) = lineID + Connect%Top(Connect%nAttached) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) + ELSE + Print*, "Too many lines connected to Point ", Connect%IdNum, " in MoorDyn!" + END IF + + END SUBROUTINE Connect_AddLine + + + ! this function handles removing a line from a connection node + !-------------------------------------------------------------- + SUBROUTINE Connect_RemoveLine(Connect, lineID, TopOfLine, rEnd, rdEnd) + + Type(MD_Connect), INTENT (INOUT) :: Connect ! the Connection object + Integer(IntKi), INTENT( IN ) :: lineID + Integer(IntKi), INTENT( OUT) :: TopOfLine + REAL(DbKi), INTENT(INOUT) :: rEnd(3) + REAL(DbKi), INTENT(INOUT) :: rdEnd(3) + + Integer(IntKi) :: l,m,J + + DO l = 1,Connect%nAttached ! look through attached lines + + IF (Connect%Attached(l) == lineID) THEN ! if this is the line's entry in the attachment list + + TopOfLine = Connect%Top(l); ! record which end of the line was attached + + DO m = l,Connect%nAttached-1 + + Connect%Attached(m) = Connect%Attached(m+1) ! move subsequent line links forward one spot in the list to eliminate this line link + Connect%Top( m) = Connect%Top(m+1) + + Connect%nAttached = Connect%nAttached - 1 ! reduce attached line counter by 1 + + ! also pass back the kinematics at the end + DO J = 1,3 + rEnd( J) = Connect%r( J) + rdEnd(J) = Connect%rd(J) + END DO + + print*, "Detached line ", lineID, " from Connection ", Connect%IdNum + + EXIT + END DO + + IF (l == Connect%nAttached) THEN ! detect if line not found + print *, "Error: failed to find line to remove during removeLineFromConnect call to connection ", Connect%IdNum, ". Line ", lineID + END IF + + END IF + + END DO + + END SUBROUTINE Connect_RemoveLine + + + +END MODULE MoorDyn_Point diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 636bfc9dbf..a3ed6ef2b9 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -13,44 +13,118 @@ include Registry_NWTC_Library.txt +## ====== some data read from the input file, but not needed after init ====== +typedef MoorDyn/MD MD_InputFileType DbKi DTIC - 0.5 - "convergence check time step for IC generation" "[s]" +typedef ^ ^ DbKi TMaxIC - 120 - "maximum time to allow for getting converged ICs" "[s]" +typedef ^ ^ ReKi CdScaleIC - 1 - "factor to scale drag coefficients by during dynamic relaxation" "[]" +typedef ^ ^ ReKi threshIC - 0.01 - "convergence tolerance for ICs (0.01 means 1%)" "[]" -## ============================== Define input types here: ============================================================================================================================================ +## ============================== Define initialization input types here: ============================================================================================================================= typedef MoorDyn/MD InitInputType ReKi g - -999.9 - "gravity constant" "[m/s^2]" typedef ^ ^ ReKi rhoW - -999.9 - "sea density" "[kg/m^3]" typedef ^ ^ ReKi WtrDepth - -999.9 - "depth of water" "[m]" -typedef ^ ^ ReKi PtfmInit {6} - - "initial position of platform" - +typedef ^ ^ ReKi PtfmInit {:}{:} - - "initial position of platform(s) shape: 6, nTurbines" - +typedef ^ ^ IntKi FarmSize - 0 - "Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0" - +typedef ^ ^ ReKi TurbineRefPos {:}{:} - - "reference position of turbines in farm, shape: 3, nTurbines" - +typedef ^ ^ ReKi Tmax - - - "simulation duration" "[s]" typedef ^ ^ CHARACTER(1024) FileName - "" - "MoorDyn input file" typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ ^ LOGICAL UsePrimaryInputFile - .TRUE. - "Read input file instead of passed data" - +typedef ^ ^ FileInfoType PassedPrimaryInputData - - - "Primary input file as FileInfoType (set by driver/glue code) -- String array with metadata" - typedef ^ ^ LOGICAL Echo - "" - "echo parameter - do we want to echo the header line describing the input file?" -typedef ^ ^ ReKi DTIC - - - "convergence check time step for IC generation" "[s]" -typedef ^ ^ ReKi TMaxIC - 120 - "maximum time to allow for getting converged ICs" "[s]" -typedef ^ ^ ReKi CdScaleIC - 1 - "factor to scale drag coefficients by during dynamic relaxation" "[]" -typedef ^ ^ ReKi threshIC - 0.01 - "convergence tolerance for ICs (0.01 means 1%)" "[]" -typedef ^ ^ CHARACTER(ChanLen) OutList {:} "" - "string containing list of output channels requested in input file" +typedef ^ ^ CHARACTER(ChanLen) OutList {:} "" - "string containing list of output channels requested in input file" +typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - + +#typedef ^ ^ DbKi UGrid {:}{:}{:} - - "water velocities time series at each grid point" - +#typedef ^ ^ DbKi UdGrid {:}{:}{:} - - "water accelerations time series at each grid point" - +#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 {:} - - "" "" +# nvm typedef ^ ^ IntKi FarmNCpldRods {:} - - "" "" +# nvm typedef ^ ^ IntKi FarmNCpldCons {:} - - "number of Fairlead Connections" "" # ====================================== Internal data types ======================================================================== # line properties from line dictionary input typedef ^ MD_LineProp IntKi IdNum - - - "integer identifier of this set of line properties" -typedef ^ ^ CHARACTER(10) name - - - "name/identifier of this set of line properties" +typedef ^ ^ CHARACTER(20) name - - - "name/identifier of this set of line properties" typedef ^ ^ DbKi d - - - "volume-equivalent diameter" "[m]" typedef ^ ^ DbKi w - - - "per-length weight in air" "[kg/m]" -typedef ^ ^ DbKi EA - - - "stiffness" "[N]" +typedef ^ ^ DbKi EA - - - "axial stiffness" "[N]" +typedef ^ ^ DbKi EA_D - - - "axial stiffness" "[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]" typedef ^ ^ DbKi Can - - - "transverse added mass coefficient" 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 ^ ^ 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 ^ ^ 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 bstiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" +typedef ^ ^ DbKi bstiffYs {30} - - "y array for stress-strain lookup table" + +# rod properties from rod dictionary input +typedef ^ MD_RodProp IntKi IdNum - - - "integer identifier of this set of rod properties" +typedef ^ ^ CHARACTER(10) name - - - "name/identifier of this set of rod properties" +typedef ^ ^ DbKi d - - - "volume-equivalent diameter" "[m]" +typedef ^ ^ DbKi w - - - "per-length weight in air" "[kg/m]" +typedef ^ ^ DbKi Can - - - "transverse added mass coefficient" +typedef ^ ^ DbKi Cat - - - "tangential added mass coefficient" +typedef ^ ^ DbKi Cdn - - - "transverse drag coefficient" +typedef ^ ^ DbKi Cdt - - - "tangential drag coefficient" +typedef ^ ^ DbKi CdEnd - - - "drag coefficient for rod end" "[-]" +typedef ^ ^ DbKi CaEnd - - - "added mass coefficient for rod end" "[-]" + +# this is the Body type, which holds data for each body object +typedef ^ MD_Body IntKi IdNum - - - "integer identifier of this Connection" +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=fixed, 1=vessel, 2=connect" +typedef ^ ^ IntKi AttachedC {30} - - "list of IdNums of connections attached to this body" +typedef ^ ^ IntKi AttachedR {30} - - "list of IdNums of rods attached to this body" +typedef ^ ^ IntKi nAttachedC - 0 - "number of attached connections" +typedef ^ ^ IntKi nAttachedR - 0 - "number of attached rods" +typedef ^ ^ DbKi rConnectRel {3}{30} - - "relative position of connection on body" +typedef ^ ^ DbKi r6RodRel {6}{30} - - "relative position and orientation of rod on body" +typedef ^ ^ DbKi bodyM - - - "" +typedef ^ ^ DbKi bodyV - - - "" +typedef ^ ^ DbKi bodyI {3} - - "" +typedef ^ ^ DbKi bodyCdA {6} - - "product of drag force and frontal area of connection point" "[m^2]" +typedef ^ ^ DbKi bodyCa {6} - - "added mass coefficient of connection point" "-" +typedef ^ ^ DbKi time - - - "current time" "[s]" +typedef ^ ^ DbKi r6 {6} - - "position" +typedef ^ ^ DbKi v6 {6} - - "velocity" +typedef ^ ^ DbKi a6 {6} - - "acceleration (only used for coupled bodies)" +typedef ^ ^ DbKi U {3} - - "water velocity at ref point" "[m/s]" +typedef ^ ^ DbKi Ud {3} - - "water acceleration at ref point" "[m/s^2]" +typedef ^ ^ DbKi zeta - - - "water surface elevation above ref point" "[m]" +typedef ^ ^ DbKi F6net {6} - - "total force and moment on body (excluding inertial loads)" +typedef ^ ^ DbKi M6net {6}{6} - - "total mass matrix of Body and any attached objects" +typedef ^ ^ DbKi M {6}{6} - - "rotated body 6-dof mass and inertia matrix in global orientation" +typedef ^ ^ DbKi M0 {6}{6} - - "body 6-dof mass and inertia matrix in its own frame" +typedef ^ ^ DbKi OrMat {3}{3} - - "DCM for body orientation" +typedef ^ ^ DbKi rCG {3} - - "vector in body frame from ref point to CG (before rods etc..)" # this is the Connection type, which holds data for each connection object typedef ^ MD_Connect IntKi IdNum - - - "integer identifier of this Connection" typedef ^ ^ CHARACTER(10) type - - - "type of Connect: fix, vessel, connect" -typedef ^ ^ IntKi TypeNum - - - "integer identifying the type. 0=fixed, 1=vessel, 2=connect" -typedef ^ ^ IntKi AttachedFairs {:} - - "list of IdNums of connected Line tops" -typedef ^ ^ IntKi AttachedAnchs {:} - - "list of IdNums of connected Line bottoms" -typedef ^ ^ DbKi conX - - - "" -typedef ^ ^ DbKi conY - - - "" -typedef ^ ^ DbKi conZ - - - "" +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=fixed, 1=vessel, 2=connect" +typedef ^ ^ IntKi Attached {10} - - "list of IdNums of lines attached to this connection 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 ^ ^ DbKi conM - - - "" typedef ^ ^ DbKi conV - - - "" typedef ^ ^ DbKi conFX - - - "" @@ -58,31 +132,127 @@ typedef ^ ^ DbKi conFY - typedef ^ ^ DbKi conFZ - - - "" typedef ^ ^ DbKi conCa - - - "added mass coefficient of connection point" "-" typedef ^ ^ DbKi conCdA - - - "product of drag force and frontal area of connection point" "[m^2]" -typedef ^ ^ DbKi Ftot {3} - - "total force on node" -typedef ^ ^ DbKi Mtot {3}{3} - - "node mass matrix, from attached lines" -typedef ^ ^ DbKi S {3}{3} - - "inverse mass matrix" "[kg]" +typedef ^ ^ DbKi time - - - "current time" "[s]" typedef ^ ^ DbKi r {3} - - "position" typedef ^ ^ DbKi rd {3} - - "velocity" +typedef ^ ^ DbKi a {3} - - "acceleration (only used for coupled points)" +typedef ^ ^ DbKi U {3} - - "water velocity at node" "[m/s]" +typedef ^ ^ DbKi Ud {3} - - "water acceleration at node" "[m/s^2]" +typedef ^ ^ DbKi zeta - - - "water surface elevation above node" "[m]" +typedef ^ ^ DbKi PDyn {:} - - "water dynamic pressure at node" "[Pa]" +typedef ^ ^ DbKi Fnet {3} - - "total force on node (excluding inertial loads)" +typedef ^ ^ DbKi M {3}{3} - - "node mass matrix, from attached lines" + +# this is the Rod type, which holds data for each Rod object +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=connect" +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 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 connection at end A: 0=pinned to Connection, 1=cantilevered to Rod." - +typedef ^ ^ IntKi endTypeB - - - "type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod." - +typedef ^ ^ DbKi UnstrLen - - - "length of the rod" "[m]" +typedef ^ ^ DbKi mass - - - "mass of the rod" "[kg]" +typedef ^ ^ DbKi rho - - - "density" "[kg/m3]" +typedef ^ ^ DbKi d - - - "volume-equivalent diameter" "[m]" +typedef ^ ^ DbKi Can - - - "" "[-]" +typedef ^ ^ DbKi Cat - - - "" "[-]" +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 time - - - "current time" "[s]" +typedef ^ ^ DbKi roll - - - "roll relative to vertical" "deg" +typedef ^ ^ DbKi pitch - - - "pitch relative to vertical" "deg" +typedef ^ ^ DbKi h0 - - - "submerged length of rod axis, distance along rod centerline from end A to the waterplane (0 <= h0 <= L)" "m" +typedef ^ ^ DbKi r {:}{:} - - "node positions" - +typedef ^ ^ DbKi rd {:}{:} - - "node velocities" - +typedef ^ ^ DbKi q {3} - - "tangent vector for rod as a whole" - +typedef ^ ^ DbKi l {:} - - "segment unstretched length" "[m]" +typedef ^ ^ DbKi V {:} - - "segment volume" "[m^3]" +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]" +typedef ^ ^ DbKi PDyn {:} - - "water dynamic pressure at node" "[Pa]" +typedef ^ ^ DbKi W {:}{:} - - "weight vectors" "[N]" +typedef ^ ^ DbKi Bo {:}{:} - - "buoyancy force vectors" "[N]" +typedef ^ ^ DbKi Pd {:}{:} - - "dynamic pressure force vectors" "[N]" +typedef ^ ^ DbKi Dp {:}{:} - - "node drag (transverse)" "[N]" +typedef ^ ^ DbKi Dq {:}{:} - - "node drag (axial)" "[N]" +typedef ^ ^ DbKi Ap {:}{:} - - "node added mass forcing (transverse)" "[N]" +typedef ^ ^ DbKi Aq {:}{:} - - "node added mass forcing (axial)" "[N]" +typedef ^ ^ DbKi B {:}{:} - - "node bottom contact force" "[N]" +typedef ^ ^ DbKi Fnet {:}{:} - - "total force on node" "[N]" +typedef ^ ^ DbKi M {:}{:}{:} - - "node mass matrix" "[kg]" +typedef ^ ^ DbKi FextA {3} - - "external forces from attached lines on/about end A " - +typedef ^ ^ DbKi FextB {3} - - "external forces from attached lines on/about end A " - +typedef ^ ^ DbKi Mext {3} - - "external moment vector holding sum of any externally applied moments i.e. bending lines" - +typedef ^ ^ DbKi r6 {6} - - "6 DOF position vector" - +typedef ^ ^ DbKi v6 {6} - - "6 DOF velocity vector" - +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 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" + # this is the Line type, which holds data for each line object typedef ^ MD_Line IntKi IdNum - - - "integer identifier of this Line" -typedef ^ ^ CHARACTER(10) type - - - "type of line. should match one of LineProp names" +#typedef ^ ^ CHARACTER(10) type - - - "type of line. should match one of LineProp names" +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 - - - "index of control channel that will drive line active tensioning (0 for none)" - +typedef ^ ^ IntKi CtrlChan - 0 - "index of control channel that will drive line active tensioning (0 for none)" - typedef ^ ^ IntKi FairConnect - - - "IdNum of Connection at fairlead" typedef ^ ^ IntKi AnchConnect - - - "IdNum of Connection at anchor" -typedef ^ ^ IntKi PropsIdNum - - - "the IdNum of the associated line properties" - typedef ^ ^ IntKi N - - - "The number of elements in the line" - +typedef ^ ^ IntKi endTypeA - - - "type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod." - +typedef ^ ^ IntKi endTypeB - - - "type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod." - typedef ^ ^ DbKi UnstrLen - - - "unstretched length of the line" - -typedef ^ ^ DbKi BA - - - "internal damping coefficient times area for this line only" "[N-s]" +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 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 ^ ^ 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 ^ ^ 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 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]" typedef ^ ^ DbKi r {:}{:} - - "node positions" - typedef ^ ^ DbKi rd {:}{:} - - "node velocities" - typedef ^ ^ DbKi q {:}{:} - - "node tangent vectors" - +typedef ^ ^ DbKi qs {:}{:} - - "segment tangent vectors" - typedef ^ ^ DbKi l {:} - - "segment unstretched length" "[m]" typedef ^ ^ DbKi ld {:} - - "segment unstretched length rate of change (used in active tensioning)" "[m]" typedef ^ ^ DbKi lstr {:} - - "segment stretched length" "[m]" typedef ^ ^ DbKi lstrd {:} - - "segment change in stretched length" "[m/s]" +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 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]" +typedef ^ ^ DbKi PDyn {:} - - "water dynamic pressure at node" "[Pa]" typedef ^ ^ DbKi T {:}{:} - - "segment tension vectors" "[N]" typedef ^ ^ DbKi Td {:}{:} - - "segment internal damping force vectors" "[N]" typedef ^ ^ DbKi W {:}{:} - - "weight/buoyancy vectors" "[N]" @@ -91,17 +261,22 @@ typedef ^ ^ DbKi Dq {:}{:} typedef ^ ^ DbKi Ap {:}{:} - - "node added mass forcing (transverse)" "[N]" typedef ^ ^ DbKi Aq {:}{:} - - "node added mass forcing (axial)" "[N]" typedef ^ ^ DbKi B {:}{:} - - "node bottom contact force" "[N]" -typedef ^ ^ DbKi F {:}{:} - - "total force on node" "[N]" +typedef ^ ^ DbKi Bs {:}{:} - - "node force due to bending moments" "[N]" +typedef ^ ^ DbKi Fnet {:}{:} - - "total force on node" "[N]" typedef ^ ^ DbKi S {:}{:}{:} - - "node inverse mass matrix" "[kg]" typedef ^ ^ DbKi M {:}{:}{:} - - "node mass matrix" "[kg]" +typedef ^ ^ DbKi EndMomentA {3} - - "vector of end moments due to bending at line end A" "[N-m]" +typedef ^ ^ DbKi EndMomentB {3} - - "vector of end moments due to bending at line end B" "[N-m]" typedef ^ ^ IntKi LineUnOut - - - "unit number of line output file" -typedef ^ ^ ReKi LineWrOutput {:} - - "one row of output data for this line" +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 MDOutParmType - a less literal alternative of the NWTC OutParmType for MoorDyn (to avoid huge lists of possible output channel permutations) -typedef ^ MD_OutParmType CHARACTER(ChanLen) Name - - - "name of output channel" -typedef ^ ^ CHARACTER(ChanLen) Units - - - "units string" +typedef ^ MD_OutParmType CHARACTER(10) Name - - - "name of output channel" +typedef ^ ^ CHARACTER(10) Units - - - "units string" typedef ^ ^ IntKi QType - - - "type of quantity - 0=tension, 1=x, 2=y, 3=z..." typedef ^ ^ IntKi OType - - - "type of object - 0=line, 1=connect" typedef ^ ^ IntKi NodeID - - - "node number if OType=0. 0=anchor, -1=N=Fairlead" @@ -113,63 +288,154 @@ typedef ^ InitOutputType CHARACTER(ChanLen) writeOutputHdr {:} " typedef ^ ^ CHARACTER(ChanLen) writeOutputUnt {:} "" - "second line of output file contents: units" typedef ^ ^ ProgDesc Ver - "" - "this module's name, version, and date" typedef ^ ^ LOGICAL CableCChanRqst {:} .FALSE. - "flag indicating control channel for drive line active tensioning is requested" - +# --- InitOutputs for linearization --- +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 (not used for glue)" - +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" - ## ============================== Define Continuous states here: ===================================================================================================================================== -typedef ^ ContinuousStateType DbKi states {:} "" - "full list of node coordinates and velocities" "[m] or [m/s]" - +typedef ^ ContinuousStateType DbKi states {:} "" - "state vector of mooring system, e.g. node coordinates and velocities" "" ## ============================== Define Discrete states here: ===================================================================================================================================== typedef ^ DiscreteStateType SiKi dummy - - - "Remove this variable if you have discrete states" - - ## ============================== Define constraint states here: ===================================================================================================================================== typedef ^ ConstraintStateType SiKi dummy - - - "Remove this variable if you have constraint states" - - ## ============================== Define Other states here: ===================================================================================================================================== typedef ^ OtherStateType SiKi dummy - - - "Remove this variable if you have other states" - ## ============================== Define Misc variables here: ===================================================================================================================================== typedef ^ MiscVarType MD_LineProp LineTypeList {:} - - "array of properties for each line type" - -typedef ^ ^ MD_Connect ConnectList {:} - - "array of connection properties" - -typedef ^ ^ MD_Line LineList {:} - - "array of line properties" - -typedef ^ ^ IntKi FairIdList {:} - - "array of size NFairs listing the ID of each fairlead (index of ConnectList)" "" -typedef ^ ^ IntKi ConnIdList {:} - - "array of size NConnss listing the ID of each connect type connection (index of ConnectList)" "" -typedef ^ ^ IntKi LineStateIndList {:} - - "starting index of each line's states in state vector" "" -typedef ^ ^ ReKi MDWrOutput {:} - - "Data from time step to be written to a MoorDyn output file" +typedef ^ ^ MD_RodProp RodTypeList {:} - - "array of properties for each rod type" - +typedef ^ ^ MD_Body GroundBody - - - "the single ground body which is the parent of all stationary connections" - +typedef ^ ^ MD_Body BodyList {:} - - "array of body objects" - +typedef ^ ^ MD_Rod RodList {:} - - "array of rod objects" - +typedef ^ ^ MD_Connect ConnectList {:} - - "array of connection objects" - +typedef ^ ^ MD_Line LineList {:} - - "array of line objects" - +typedef ^ ^ MD_Fail FailList {:} - - "array of line objects" - +typedef ^ ^ IntKi FreeConIs {:} - - "array of free connection indices in ConnectList vector" "" +typedef ^ ^ IntKi CpldConIs {:}{:} - - "array of coupled/fairlead connection indices in ConnectList vector" "" +typedef ^ ^ IntKi FreeRodIs {:} - - "array of free rod indices in RodList vector" "" +typedef ^ ^ IntKi CpldRodIs {:}{:} - - "array of coupled/fairlead rod indices in RodList vector" "" +typedef ^ ^ IntKi FreeBodyIs {:} - - "array of free body indices in BodyList vector" "" +typedef ^ ^ IntKi CpldBodyIs {:}{:} - - "array of coupled body indices in BodyList vector" "" +typedef ^ ^ IntKi LineStateIs1 {:} - - "starting index of each line's states in state vector" "" +typedef ^ ^ IntKi LineStateIsN {:} - - "ending index of each line's states in state vector" "" +typedef ^ ^ IntKi ConStateIs1 {:} - - "starting index of each line's states in state vector" "" +typedef ^ ^ IntKi ConStateIsN {:} - - "ending index of each line's states in state vector" "" +typedef ^ ^ IntKi RodStateIs1 {:} - - "starting index of each rod's states in state vector" "" +typedef ^ ^ IntKi RodStateIsN {:} - - "ending index of each rod's states in state vector" "" +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 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)" +typedef ^ ^ DbKi zeros6 {6} - - "array of zeros for convenience" +typedef ^ ^ DbKi MDWrOutput {:} - - "Data from time step to be written to a MoorDyn output file" +typedef ^ ^ DbKi LastOutTime - - - "Time of last writing to MD output files" +typedef ^ ^ ReKi PtfmInit {6} - - "initial position of platform for an individual (non-farm) MD instance" - +typedef ^ ^ DbKi BathymetryGrid {:}{:} - - "matrix describing the bathymetry in a grid of x's and y's" +typedef ^ ^ DbKi BathGrid_Xs {:} - - "array of x-coordinates in the bathymetry grid" +typedef ^ ^ DbKi BathGrid_Ys {:} - - "array of y-coordinates in the bathymetry grid" +typedef ^ ^ IntKi BathGrid_npoints {:} - - "number of grid points to describe the bathymetry grid" ## ============================== Parameters ============================================================================================================================================ -typedef ^ ParameterType IntKi NTypes - - - "number of line types" "" -typedef ^ ^ IntKi NConnects - - - "number of Connection objects" "" -typedef ^ ^ IntKi NFairs - - - "number of Fairlead Connections" "" -typedef ^ ^ IntKi NConns - - - "number of Connect type Connections - not to be confused with NConnects" "" -typedef ^ ^ IntKi NAnchs - - - "number of Anchor type Connections" "" -typedef ^ ^ IntKi NLines - - - "number of Line objects" "" -typedef ^ ^ ReKi g - 9.81 - "gravitational constant" "[kg/m^2]" -typedef ^ ^ ReKi rhoW - - - "density of seawater" "[m]" -typedef ^ ^ ReKi WtrDpth - - - "water depth" "[m]" -typedef ^ ^ ReKi kBot - - - "bottom stiffness" "[Pa/m]" -typedef ^ ^ ReKi cBot - - - "bottom damping" "[Pa-s/m]" -typedef ^ ^ ReKi dtM0 - - - "desired mooring model time step" "[s]" -typedef ^ ^ ReKi dtCoupling - - - "coupling time step that MoorDyn should expect" "[s]" +typedef ^ ParameterType IntKi nLineTypes - 0 - "number of line types" "" +typedef ^ ^ IntKi nRodTypes - 0 - "number of rod types" "" +typedef ^ ^ IntKi nConnects - 0 - "number of Connection objects" "" +typedef ^ ^ IntKi nConnectsExtra - 0 - "number of Connection objects including space for extra ones that could arise from line failures" "" +typedef ^ ^ IntKi nBodies - 0 - "number of Body objects" "" +typedef ^ ^ IntKi nRods - 0 - "number of Rod objects" "" +typedef ^ ^ IntKi nLines - 0 - "number of Line objects" "" +typedef ^ ^ IntKi nCtrlChans - 0 - "number of distinct control channels specified for use as inputs" "" +typedef ^ ^ IntKi nFails - 0 - "number of failure conditions" "" +typedef ^ ^ IntKi nFreeBodies - 0 - "" "" +typedef ^ ^ IntKi nFreeRods - 0 - "" "" +typedef ^ ^ IntKi nFreeCons - 0 - "" "" +typedef ^ ^ IntKi nCpldBodies {:} - - "number of coupled bodies (for FAST.Farm, size>1 with an entry for each turbine)" "" +typedef ^ ^ IntKi nCpldRods {:} - - "number of coupled rods (for FAST.Farm, size>1 with an entry for each turbine)" "" +typedef ^ ^ IntKi nCpldCons {:} - - "number of coupled points (for FAST.Farm, size>1 with an entry for each turbine)" "" +typedef ^ ^ IntKi NConns - 0 - "number of Connect type Connections - not to be confused with NConnects" "" +typedef ^ ^ IntKi NAnchs - 0 - "number of Anchor type Connections" "" +typedef ^ ^ DbKi Tmax - - - "simulation duration" "[s]" +typedef ^ ^ DbKi g - 9.81 - "gravitational constant (positive)" "[m/s^2]" +typedef ^ ^ DbKi rhoW - 1025 - "density of seawater" "[kg/m^3]" +typedef ^ ^ DbKi WtrDpth - - - "water depth" "[m]" +typedef ^ ^ DbKi kBot - - - "bottom stiffness" "[Pa/m]" +typedef ^ ^ DbKi cBot - - - "bottom damping" "[Pa-s/m]" +typedef ^ ^ DbKi dtM0 - - - "desired mooring model time step" "[s]" +typedef ^ ^ DbKi dtCoupling - - - "coupling time step that MoorDyn should expect" "[s]" typedef ^ ^ IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ^ DbKi dtOut - - - "interval for writing output file lines" "[s]" typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" - typedef ^ ^ MD_OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - typedef ^ ^ CHARACTER(1) Delim - - - "Column delimiter for output text files" - typedef ^ ^ IntKi MDUnOut - - - "Unit number of main output file" +typedef ^ ^ CHARACTER(1024) PriPath - - - "The path to the primary MoorDyn input file, used if looking for additional input files" +typedef ^ ^ IntKi writeLog - -1 - "Switch for level of log file output" +#NOTE: there may be an issue with start/restart with the UnLog stored in parameters. We'll ignore this for now -- ADP +typedef ^ ^ IntKi UnLog - -1 - "Unit number of log file" +typedef ^ ^ IntKi WaveKin - - - "Flag for whether or how to consider water kinematics" +typedef ^ ^ IntKi Current - - - "Flag for whether or how to consider water kinematics" +typedef ^ ^ IntKi nTurbines - - - "Number of turbines if MoorDyn is performing an array-level simulation with FAST.Farm, otherwise 0" +typedef ^ ^ ReKi TurbineRefPos {:}{:} - - "reference position of turbines in farm, shape: 3, nTurbines" - +typedef ^ ^ DbKi mu_kT - - - "transverse kinetic friction coefficient" "(-)" +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" "(-)" +# --- parameters for wave and current --- +typedef ^ ^ IntKi nxWave - - - "number of x wave grid points" - +typedef ^ ^ IntKi nyWave - - - "number of y wave grid points" - +typedef ^ ^ IntKi nzWave - - - "number of z wave grid points" - +typedef ^ ^ IntKi ntWave - - - "number of wave time steps" - +typedef ^ ^ SiKi pxWave {:} - - "x location of wave grid points" - +typedef ^ ^ SiKi pyWave {:} - - "y location of wave grid points" - +typedef ^ ^ SiKi pzWave {:} - - "z location of wave grid points" - +typedef ^ ^ SiKi dtWave - - - "wave data time step" - +typedef ^ ^ SiKi uxWave {:}{:}{:}{:} - - "wave velocities time series at each grid point" - +typedef ^ ^ SiKi uyWave {:}{:}{:}{:} - - "wave velocities time series at each grid point" - +typedef ^ ^ SiKi uzWave {:}{:}{:}{:} - - "wave velocities time series at each grid point" - +typedef ^ ^ SiKi axWave {:}{:}{:}{:} - - "wave accelerations time series at each grid point" - +typedef ^ ^ SiKi ayWave {:}{:}{:}{:} - - "wave accelerations time series at each grid point" - +typedef ^ ^ SiKi azWave {:}{:}{:}{:} - - "wave accelerations time series at each grid point" - +typedef ^ ^ SiKi PDyn {:}{:}{:}{:} - - "wave dynamic pressure time series at each grid point" - +typedef ^ ^ SiKi zeta {:}{:}{:} - - "wave surface elevations time series at each surface grid point" - +typedef ^ ^ IntKi nzCurrent - - - "number of z current grid points" - +typedef ^ ^ SiKi pzCurrent {:} - - "z location of current grid points" - +typedef ^ ^ SiKi uxCurrent {:} - - "current velocities time series at each grid point" - +typedef ^ ^ SiKi uyCurrent {:} - - "current velocities time series at each grid point" - +# --- Parameters for linearization --- +typedef ^ ^ Integer Nx0 - - - "copy of initial size of system state vector, for linearization routines" - +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_nx - - - "number of continuous states in jacobian matrix" - +typedef ^ ^ Integer dxIdx_map2_xStateIdx {:} - - "Mapping array from index of dX array to corresponding state index" - # ============================== Inputs ============================================================================================================================================ -typedef ^ InputType MeshType PtFairleadDisplacement - - - "mesh for position AND VELOCITY of each fairlead in X,Y,Z" "[m, m/s]" -# typedef ^ ^ MeshType HydroForceLineMesh - - - "Meshed input data" - -typedef ^ ^ ReKi DeltaL {:} - - "change in line length command for each channel" "[m]" -typedef ^ ^ ReKi DeltaLdot {:} - - "rate of change of line length command for each channel" "[m]" +typedef ^ InputType MeshType CoupledKinematics {:} - - "array of meshes for each coupling point (6 DOF info used for rods and bodies)" "[m, m/s]" <<<< will use this eventually! +typedef ^ ^ ReKi DeltaL {:} - - "change in line length command for each channel" "[m]" +typedef ^ ^ ReKi DeltaLdot {:} - - "rate of change of line length command for each channel" "[m]" +#typedef ^ ^ DbKi U {:}{:} - - "water velocities at each node" - +#typedef ^ ^ DbKi Ud {:}{:} - - "water accelerations at each node" - +#typedef ^ ^ DbKi zeta {:} - - "water surface elevations above each node" - +#typedef ^ ^ DbKi PDyn {:} - - "water dynamic pressure at each node" - ## ============================== Outputs ============================================================================================================================================ -typedef ^ OutputType MeshType PtFairleadLoad - - - "point mesh for fairlead forces in X,Y,Z" "[N]" +typedef ^ OutputType MeshType CoupledLoads {:} - - "array of point meshes for mooring reaction forces (and moments) at coupling points" "[N]" typedef ^ ^ ReKi WriteOutput {:} - - "output vector returned to glue code" "" -# typedef ^ ^ MeshType LineMeshPosition - - - "Meshed output data" - +# should CoupledLoads be an array? +#typedef ^ ^ DbKi rAll {:}{:} - - "Mesh of all point positions: bodies, rods, points, line internal nodes" - diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 new file mode 100644 index 0000000000..26bd00c96b --- /dev/null +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -0,0 +1,1194 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall +! +! This file is part of MoorDyn. +! +! 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 MoorDyn_Rod + + USE MoorDyn_Types + USE MoorDyn_IO + USE NWTC_Library + USE MoorDyn_Misc + USE MoorDyn_Line, only : Line_SetEndKinematics, Line_GetEndStuff, Line_SetEndOrientation, Line_GetEndSegmentInfo + + IMPLICIT NONE + + PRIVATE + + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output + + PUBLIC :: Rod_Setup + PUBLIC :: Rod_Initialize + PUBLIC :: Rod_SetKinematics + PUBLIC :: Rod_SetState + PUBLIC :: Rod_GetStateDeriv + PUBLIC :: Rod_DoRHS + PUBLIC :: Rod_GetCoupledForce + PUBLIC :: Rod_GetNetForceAndMass + PUBLIC :: Rod_AddLine + PUBLIC :: Rod_RemoveLine + + + +CONTAINS + + + !----------------------------------------------------------------------- + SUBROUTINE Rod_Setup(Rod, RodProp, endCoords, p, ErrStat, ErrMsg) + + TYPE(MD_Rod), INTENT(INOUT) :: Rod ! the single rod object of interest + TYPE(MD_RodProp), INTENT(INOUT) :: RodProp ! the single rod property set for the line of interest + REAL(DbKi), INTENT(IN) :: endCoords(6) + TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters + 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 ! Generic index + INTEGER(4) :: K ! Generic index + INTEGER(IntKi) :: N + + Real(DbKi) :: phi, beta, sinPhi, cosPhi, tanPhi, sinBeta, cosBeta ! various orientation things + Real(DbKi) :: k_hat(3) ! unit vector (redundant, not used) <<<< + + INTEGER :: ErrStat2 + + N = Rod%N ! number of segments in this line (for code readability) + + ! -------------- save some section properties to the line object itself ----------------- + + Rod%d = RodProp%d + Rod%rho = RodProp%w/(Pi/4.0 * Rod%d * Rod%d) + + Rod%Can = RodProp%Can + Rod%Cat = RodProp%Cat + Rod%Cdn = RodProp%Cdn + Rod%Cdt = RodProp%Cdt + Rod%CaEnd = RodProp%CaEnd + Rod%CdEnd = RodProp%CdEnd + + + ! 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 + + ! allocate segment scalar quantities + if (Rod%N == 0) then ! special case of zero-length Rod + ALLOCATE(Rod%l(1), Rod%V(N), STAT=ErrStat2); if(AllocateFailed("Rod: l and V")) return + else ! normal case + ALLOCATE(Rod%l(N), Rod%V(N), STAT=ErrStat2); if(AllocateFailed("Rod: l and V")) return + end if + + ! allocate water related vectors + ALLOCATE(Rod%U(3, 0:N), Rod%Ud(3, 0:N), Rod%zeta(0:N), Rod%PDyn(0:N), STAT=ErrStat2) + if(AllocateFailed("Rod: U Ud zeta PDyn")) return + + ! allocate node force vectors + ALLOCATE(Rod%W(3, 0:N), Rod%Bo(3, 0:N), Rod%Dp(3, 0:N), Rod%Dq(3, 0:N), Rod%Ap(3, 0:N), & + Rod%Aq(3, 0:N), Rod%Pd(3, 0:N), Rod%B(3, 0:N), Rod%Fnet(3, 0:N), STAT=ErrStat2) + if(AllocateFailed("Rod: force arrays")) return + + ! allocate mass and inverse mass matrices for each node (including ends) + ALLOCATE(Rod%M(3, 3, 0:N), STAT=ErrStat2); if(AllocateFailed("Rod: M")) return + + + ! set to zero initially (important of wave kinematics are not being used) + Rod%U = 0.0_DbKi + Rod%Ud = 0.0_DbKi + Rod%zeta = 0.0_DbKi + Rod%PDyn = 0.0_DbKi + + ! ------------------------- set some geometric properties and the starting kinematics ------------------------- + + CALL UnitVector(endCoords(1:3), endCoords(4:6), Rod%q, Rod%UnstrLen) ! get Rod axis direction vector and Rod length + + ! set Rod positions (some or all may be overwritten depending on if the Rod is coupled or attached to a Body) + Rod%r6(1:3) = endCoords(1:3) ! (end A coordinates) + Rod%v6(1:3) = 0.0_DbKi ! (end A velocity, unrotated axes) + + Rod%r6(4:6) = Rod%q ! (Rod direction unit vector) + Rod%v6(4:6) = 0.0_DbKi ! (rotational velocities about unrotated axes) + + ! save mass for future calculations >>>> should calculate I_l and I_r here in future <<<< + Rod%mass = Rod%UnstrLen*RodProp%w + + + ! assign values for l and V + if (Rod%N == 0) then + Rod%l(1) = 0.0_DbKi + Rod%V(1) = 0.0_DbKi + else + DO i=1,N + Rod%l(i) = Rod%UnstrLen/REAL(N, DbKi) + Rod%V(i) = Rod%l(i)*0.25*Pi*RodProp%d*RodProp%d + END DO + end if + + + ! set gravity and bottom contact forces to zero initially (because the horizontal components should remain at zero) + Rod%W = 0.0_DbKi + Rod%B = 0.0_DbKi + + ! calculate some orientation items to be used for mesh setup + call GetOrientationAngles(Rod%q, phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, cosBeta, k_hat) ! calculate some orientation information for the Rod as a whole + Rod%OrMat = CalcOrientation(phi, beta, 0.0_DbKi) ! get rotation matrix to put things in global rather than rod-axis orientations + + + 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 <<< + + + CONTAINS + + LOGICAL FUNCTION AllocateFailed(arrayName) + CHARACTER(*), INTENT(IN ) :: arrayName ! The array name + call SetErrStat(ErrStat2, "Error allocating space for "//trim(arrayName)//" array.", ErrStat, ErrMsg, 'Rod_Setup') + AllocateFailed = ErrStat2 >= AbortErrLev + !if (AllocateFailed) call CleanUp() + END FUNCTION AllocateFailed + + END SUBROUTINE Rod_Setup + !-------------------------------------------------------------- + + + + + ! Make output file for Rod and set end kinematics of any attached lines. + ! For free Rods, fill in the initial states into the state vector. + ! Notes: r6 and v6 must already be set. + ! ground- or body-pinned rods have already had setKinematics called to set first 3 elements of r6, v6. + !-------------------------------------------------------------- + SUBROUTINE Rod_Initialize(Rod, states, m) + + TYPE(MD_Rod), INTENT(INOUT) :: Rod ! the rod object + Real(DbKi), INTENT(INOUT) :: states(:) ! state vector section for this line + 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 + + IF (wordy > 0) print *, "initializing Rod ", Rod%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? <<<<< + + + ! Pass kinematics to any attached lines (this is just like what a Connection does, except for both ends) + ! so that they have the correct initial positions at this initialization stage. + + if (Rod%typeNum >- 2) CALL Rod_SetDependentKin(Rod, 0.0_DbKi, m, .TRUE.) ! don't call this for type -2 coupled Rods as it's already been called + + + ! assign the resulting kinematics to its part of the state vector (only matters if it's an independent Rod) + + if (Rod%typeNum == 0) then ! free Rod type + + states(1:6) = 0.0_DbKi ! zero velocities for initialization + states(7:9) = Rod%r(:,0) ! end A position + states(10:12) = Rod%q ! rod direction unit vector + + else if (abs(Rod%typeNum) ==1 ) then ! pinned rod type (coupled or attached to something previously via setPinKin) + + states(1:3) = 0.0_DbKi ! zero velocities for initialization + states(4:6) = Rod%q ! rod direction unit vector + + end if + + ! note: this may also be called by a coupled rod (type = -1) in which case states will be empty + + + END SUBROUTINE Rod_Initialize + !-------------------------------------------------------------- + + + + + ! set kinematics for Rods ONLY if they are attached to a body (including a coupled body) or coupled (otherwise shouldn't be called) + !-------------------------------------------------------------- + SUBROUTINE Rod_SetKinematics(Rod, r6_in, v6_in, a6_in, t, m) + + Type(MD_Rod), INTENT(INOUT) :: Rod ! the Rod object + 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 (only used for coupled rods) + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + INTEGER(IntKi) :: l + + Rod%time = t ! store current time + + + if (abs(Rod%typeNum) == 2) then ! rod rigidly coupled to a body, or ground, or coupling point + Rod%r6 = r6_in + Rod%v6 = v6_in + Rod%a6 = a6_in + + call ScaleVector(Rod%r6(4:6), 1.0_DbKi, Rod%r6(4:6)); ! enforce direction vector to be a unit vector + + ! since this rod has no states and all DOFs have been set, pass its kinematics to dependent Lines + CALL Rod_SetDependentKin(Rod, t, m, .FALSE.) + + else if (abs(Rod%typeNum) == 1) then ! rod end A pinned to a body, or ground, or coupling point + + ! set Rod *end A only* kinematics based on BCs (linear model for now) + Rod%r6(1:3) = r6_in(1:3) + Rod%v6(1:3) = v6_in(1:3) + Rod%a6(1:3) = a6_in(1:3) + + + ! Rod is pinned so only end A is specified, rotations are left alone and will be + ! 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." ! <<< + end if + + + ! update Rod direction unit vector (simply equal to last three entries of r6, presumably these were set elsewhere for pinned Rods) + Rod%q = Rod%r6(4:6) + + + + END SUBROUTINE Rod_SetKinematics + !-------------------------------------------------------------- + + ! pass the latest states to the rod if it has any DOFs/states (then update rod end kinematics including attached lines) + !-------------------------------------------------------------- + SUBROUTINE Rod_SetState(Rod, X, t, m) + + Type(MD_Rod), INTENT(INOUT) :: Rod ! the Rod object + Real(DbKi), INTENT(IN ) :: X(:) ! state vector section for this line + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + INTEGER(IntKi) :: J ! index + + + ! for a free Rod, there are 12 states: + ! [ x, y, z velocity of end A, then rate of change of u/v/w coordinates of unit vector pointing toward end B, + ! then x, y, z coordinate of end A, u/v/w coordinates of unit vector pointing toward end B] + + ! for a pinned Rod, there are 6 states (rotational only): + ! [ rate of change of u/v/w coordinates of unit vector pointing toward end B, + ! then u/v/w coordinates of unit vector pointing toward end B] + + + ! store current time + Rod%time = t + + + ! copy over state values for potential use during derivative calculations + if (Rod%typeNum == 0) then ! free Rod type + + ! CALL ScaleVector(X(10:12), 1.0, X(10:12)) ! enforce direction vector to be a unit vector <<<< can't do this with FAST frameowrk, could be a problem!! + + ! TODO: add "controller" adjusting state derivatives of X(10:12) to artificially force X(10:12) to remain a unit vector <<<<<<<<<<< + + + Rod%r6(1:3) = X(7:9) ! (end A coordinates) + Rod%v6(1:3) = X(1:3) ! (end A velocity, unrotated axes) + CALL ScaleVector(X(10:12), 1.0_DbKi, Rod%r6(4:6)) !Rod%r6(4:6) = X(10:12) ! (Rod direction unit vector) + Rod%v6(4:6) = X(4:6) ! (rotational velocities about unrotated axes) + + + CALL Rod_SetDependentKin(Rod, t, m, .FALSE.) + + else if (abs(Rod%typeNum) == 1) then ! pinned rod type (coupled or attached to something)t previously via setPinKin) + + !CALL ScaleVector(X(4:6), 1.0, X(4:6)) ! enforce direction vector to be a unit vector + + + CALL ScaleVector(X(4:6), 1.0_DbKi, Rod%r6(4:6)) !Rod%r6(3+J) = X(3+J) ! (Rod direction unit vector) + Rod%v6(4:6) = X(1:3) ! (rotational velocities about unrotated axes) + + + CALL Rod_SetDependentKin(Rod, t, m, .FALSE.) + + else + print *, "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) + Rod%q = Rod%r6(4:6) + + END SUBROUTINE Rod_SetState + !-------------------------------------------------------------- + + + ! Set the Rod end kinematics then set the kinematics of dependent objects (any attached lines). + ! This also determines the orientation of zero-length rods. + !-------------------------------------------------------------- + SUBROUTINE Rod_SetDependentKin(Rod, t, m, initial) + + Type(MD_Rod), INTENT(INOUT) :: Rod ! the Rod object + 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 Connections) + 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) :: 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) :: 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) :: qMomentSum(3) ! summation of qEnd*EI/dl_stretched (with correct sign) for each attached line + + + ! Initialize variables + qMomentSum = 0.0_DbKi + + ! in future pass accelerations here too? <<<< + + N = Rod%N + + ! from state values, set positions of end nodes + ! end A + Rod%r(:,0) = Rod%r6(1:3) ! positions + Rod%rd(:,0) = Rod%v6(1:3) ! velocities + + !print *, Rod%r6(1:3) + !print *, Rod%r(:,0) + + if (Rod%N > 0) then ! set end B nodes only if the rod isn't zero length + CALL transformKinematicsAtoB(Rod%r6(1:3), Rod%r6(4:6), Rod%UnstrLen, Rod%v6, Rod%r(:,N), Rod%rd(:,N)) ! end B + end if + + ! pass end node kinematics to any attached lines (this is just like what a Connection does, except for both ends) + DO l=1,Rod%nAttachedA + CALL Line_SetEndKinematics(m%LineList(Rod%attachedA(l)), Rod%r(:,0), Rod%rd(:,0), t, Rod%TopA(l)) + END DO + DO l=1,Rod%nAttachedB + CALL Line_SetEndKinematics(m%LineList(Rod%attachedB(l)), Rod%r(:,N), Rod%rd(:,N), t, Rod%TopB(l)) + END DO + + + ! if this is a zero-length Rod and we're passed initialization, get bending moment-related information from attached lines and compute Rod's equilibrium orientation + if ((N==0) .and. (.not. initial)) then + + DO l=1,Rod%nAttachedA + + CALL Line_GetEndSegmentInfo(m%LineList(Rod%attachedA(l)), q_EI_dl, Rod%TopA(l), 0) + + qMomentSum = qMomentSum + q_EI_dl ! add each component to the summation vector + + END DO + + DO l=1,Rod%nAttachedB + + CALL Line_GetEndSegmentInfo(m%LineList(Rod%attachedB(l)), q_EI_dl, Rod%TopB(l), 1) + + qMomentSum = qMomentSum + q_EI_dl ! add each component to the summation vector + + END DO + + ! solve for line unit vector that balances all moments (unit vector of summation of qEnd*EI/dl_stretched over each line) + CALL ScaleVector(qMomentSum, 1.0_DbKi, Rod%q) + + Rod%r6(4:6) = Rod%q ! set orientation angles + END IF + + ! pass Rod orientation to any attached lines (this is just like what a Connection does, except for both ends) + DO l=1,Rod%nAttachedA + CALL Line_SetEndOrientation(m%LineList(Rod%attachedA(l)), Rod%q, Rod%TopA(l), 0) + END DO + DO l=1,Rod%nAttachedB + CALL Line_SetEndOrientation(m%LineList(Rod%attachedB(l)), Rod%q, Rod%TopB(l), 1) + END DO + + END SUBROUTINE Rod_SetDependentKin + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Rod_GetStateDeriv(Rod, Xd, m, p) + + Type(MD_Rod), INTENT(INOUT) :: Rod ! the Rod object + Real(DbKi), INTENT(INOUT) :: Xd(:) ! state derivative vector section for this line + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects (for simplicity, since Bodies deal with Rods and Connections) + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + !TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables + + INTEGER(IntKi) :: J ! index + + Real(DbKi) :: Fnet (6) ! net force and moment about reference point + Real(DbKi) :: M_out (6,6) ! mass matrix about reference point + + 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) :: y_temp (6) ! temporary vector for LU decomposition + Real(DbKi) :: LU_temp(6,6) ! temporary matrix for LU decomposition + + ! Initialize some things to zero + y_temp = 0.0_DbKi +! 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) + + + + ! TODO: add "controller" adjusting state derivatives of X(10:12) to artificially force X(10:12) to remain a unit vector <<<<<<<<<<< + + ! fill in state derivatives + IF (Rod%typeNum == 0) THEN ! free Rod type, 12 states + + ! solve for accelerations in [M]{a}={f} using LU decomposition + CALL LUsolve(6, M_out, LU_temp, Fnet, y_temp, acc) + + Xd(7:9) = Rod%v6(1:3) !Xd[6 + I] = v6[ I]; ! dxdt = V (velocities) + Xd(1:6) = acc !Xd[ I] = acc[ I]; ! dVdt = a (accelerations) + !Xd[3 + I] = acc[3+I]; ! rotational accelerations + + ! rate of change of unit vector components!! CHECK! <<<<< + Xd(10) = - Rod%v6(6)*Rod%r6(5) + Rod%v6(5)*Rod%r6(6) ! i.e. u_dot_x = -omega_z*u_y + omega_y*u_z + Xd(11) = Rod%v6(6)*Rod%r6(4) - Rod%v6(4)*Rod%r6(6) ! i.e. u_dot_y = omega_z*u_x - omega_x*u_z + Xd(12) = -Rod%v6(5)*Rod%r6(4) + Rod%v6(4)*Rod%r6(5) ! i.e. u_dot_z = -omega_y*u_x - omega_x*u_y + + ! store accelerations in case they're useful as output + Rod%a6 = acc + + 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)) ! << 1) THEN + print *, " state derivatives:" + print *, Xd + + print *, "r0" + print *, Rod%r(:,0) + print *, "F" + print *, Fnet + print *, "M" + print *, M_out + print *, "acc" + print *, acc + END IF + + EXIT + END IF + END DO + + END SUBROUTINE Rod_GetStateDeriv + !-------------------------------------------------------------- + + + ! calculate the forces on the rod, including from attached lines + !-------------------------------------------------------------- + SUBROUTINE Rod_DoRHS(Rod, m, p) + + Type(MD_Rod), INTENT(INOUT) :: Rod ! the Rodion object + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + !TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables + + INTEGER(IntKi) :: l ! index of attached lines + INTEGER(IntKi) :: I,J,K ! index + + + INTEGER(IntKi) :: N ! number of rod elements for convenience + + Real(DbKi) :: phi, beta, sinPhi, cosPhi, tanPhi, sinBeta, cosBeta ! various orientation things + Real(DbKi) :: k_hat(3) ! unit vector (redundant, not used) <<<< + Real(DbKi) :: Ftemp ! temporary force component + Real(DbKi) :: Mtemp ! temporary moment component + + Real(DbKi) :: m_i, v_i ! + Real(DbKi) :: zeta ! wave elevation above/below a given node + !Real(DbKi) :: h0 ! distance along rod centerline from end A to the waterplane + Real(DbKi) :: deltaL ! submerged length of a given segment + Real(DbKi) :: Lsum ! cumulative length along rod axis from bottom + Real(DbKi) :: dL ! length attributed to node + Real(DbKi) :: VOF ! fraction of volume associated with node that is submerged + + Real(DbKi) :: VOF0 ! original VOF based only on axis before refinement + Real(DbKi) :: z1hi ! highest elevation of cross section at node [m] + Real(DbKi) :: z1lo ! lowest elevation of cross section at node [m] + Real(DbKi) :: G ! distance normal to axis from bottom edge of cross section to waterplane [m] + Real(DbKi) :: al ! angle involved in circular segment buoyancy calc [rad] + Real(DbKi) :: A ! area of cross section at node that is below the waterline [m2] + Real(DbKi) :: zA ! crude approximation to z value of centroid of submerged cross section at node [m] + + + Real(DbKi) :: Vi(3) ! relative flow velocity over a node + Real(DbKi) :: SumSqVp, SumSqVq, MagVp, MagVq + Real(DbKi) :: Vp(3), Vq(3) ! transverse and axial components of water velocity at a given node + Real(DbKi) :: ap(3), aq(3) ! transverse and axial components of water acceleration at a given node + Real(DbKi) :: Fnet_i(3) ! force from an attached line + Real(DbKi) :: Mnet_i(3) ! moment from an attached line + Real(DbKi) :: Mass_i(3,3) ! mass from an attached line + + ! used in lumped 6DOF calculations: + Real(DbKi) :: rRel( 3) ! relative position of each node i from rRef + !Real(DbKi) :: OrMat(3,3) ! rotation matrix to rotate global z to rod's axis + Real(DbKi) :: F6_i(6) ! a node's contribution to the total force vector + Real(DbKi) :: M6_i(6,6) ! a node's contribution to the total mass matrix + Real(DbKi) :: I_l ! axial inertia of rod + Real(DbKi) :: I_r ! radial inertia of rod about CG + Real(DbKi) :: Imat_l(3,3) ! inertia about CG aligned with Rod axis + Real(DbKi) :: Imat(3,3) ! inertia about CG in global frame + Real(DbKi) :: h_c ! location of CG along axis + Real(DbKi) :: r_c(3) ! 3d location of CG relative to node A + Real(DbKi) :: Fcentripetal(3) ! centripetal force + Real(DbKi) :: Mcentripetal(3) ! centripetal moment + + Real(DbKi) :: depth ! local interpolated depth from bathymetry grid [m] + Real(DbKi) :: nvec(3) ! local seabed surface normal vector (positive out) + + + N = Rod%N + + ! ------------------------------ zero some things -------------------------- + + Rod%Mext = 0.0_DbKi ! zero the external moment sum + + Lsum = 0.0_DbKi + + + ! ---------------------------- initial rod and node calculations ------------------------ + + ! calculate some orientation information for the Rod as a whole + !call GetOrientationAngles(Rod%r( :,0), Rod%r( :,N), phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, cosBeta, k_hat) + call GetOrientationAngles(Rod%q, phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, cosBeta, k_hat) + + ! save to internal roll and pitch variables for use in output <<< should check these, make Euler angles isntead of independent <<< + Rod%roll = -phi*sinBeta + Rod%pitch = phi*cosBeta + + ! set interior node positions and velocities (stretch the nodes between the endpoints linearly) (skipped for zero-length Rods) + DO i=1,N-1 + Rod%r( :,i) = Rod%r( :,0) + (Rod%r( :,N) - Rod%r( :,0)) * (REAL(i)/REAL(N)) + Rod%rd(:,i) = Rod%rd(:,0) + (Rod%rd(:,N) - Rod%rd(:,0)) * (REAL(i)/REAL(N)) + + Rod%V(i) = 0.25*pi * Rod%d*Rod%d * Rod%l(i) ! volume attributed to segment + END DO + + + ! apply wave kinematics (if there are any) + + DO i=0,N + CALL getWaterKin(p, Rod%r(1,i), Rod%r(2,i), Rod%r(3,i), Rod%time, m%WaveTi, Rod%U(:,i), Rod%Ud(:,i), Rod%zeta(i), Rod%PDyn(i)) + !F(i) = 1.0 ! set VOF value to one for now (everything submerged - eventually this should be element-based!!!) <<<< + ! <<<< currently F is not being used and instead a VOF variable is used within the node loop + END DO + + ! Calculated h0 (note this should be deprecated/replced) + zeta = Rod%zeta(N) ! temporary + ! get approximate location of waterline crossing along Rod axis (note: negative h0 indicates end A is above end B, and measures -distance from end A to waterline crossing) + if ((Rod%r(3,0) < zeta) .and. (Rod%r(3,N) < zeta)) then ! fully submerged case + Rod%h0 = Rod%UnstrLen + else if ((Rod%r(3,0) < zeta) .and. (Rod%r(3,N) > zeta)) then ! check if it's crossing the water plane (should also add some limits to avoid near-horizontals at some point) + Rod%h0 = (zeta - Rod%r(3,0))/Rod%q(3) ! distance along rod centerline from end A to the waterplane + else if ((Rod%r(3,N) < zeta) .and. (Rod%r(3,0) > zeta)) then ! check if it's crossing the water plane but upside down + Rod%h0 = -(zeta - Rod%r(3,0))/Rod%q(3) ! negative distance along rod centerline from end A to the waterplane + else + Rod%h0 = 0.0_DbKi ! fully unsubmerged case (ever applicable?) + end if + + + ! -------------------------- loop through all the nodes ----------------------------------- + DO I = 0, N + + + ! ------------------ calculate added mass matrix for each node ------------------------- + + ! get mass and volume considering adjacent segment lengths + IF (I==0) THEN + dL = 0.5*Rod%l(1) + m_i = 0.25*Pi * Rod%d*Rod%d * dL *Rod%rho ! (will be zero for zero-length Rods) + v_i = 0.5 *Rod%V(1) + ELSE IF (I==N) THEN + dL = 0.5*Rod%l(N) + m_i = 0.25*pi * Rod%d*Rod%d * dL *Rod%rho + v_i = 0.5*Rod%V(N) + ELSE + dL = 0.5*(Rod%l(I) + Rod%l(I+1)) + m_i = 0.25*pi * Rod%d*Rod%d * dL *Rod%rho + v_i = 0.5 *(Rod%V(I) + Rod%V(I+1)) + END IF + + ! get scalar for submerged portion + if (Rod%h0 < 0.0_DbKi) then ! upside down partially-submerged Rod case + IF (Lsum >= -Rod%h0) THEN ! if fully submerged + VOF0 = 1.0_DbKi + ELSE IF (Lsum + dL > -Rod%h0) THEN ! if partially below waterline + VOF0 = (Lsum+dL + Rod%h0)/dL + ELSE ! must be out of water + VOF0 = 0.0_DbKi + END IF + else + IF (Lsum + dL <= Rod%h0) THEN ! if fully submerged + VOF0 = 1.0_DbKi + ELSE IF (Lsum < Rod%h0) THEN ! if partially below waterline + VOF0 = (Rod%h0 - Lsum)/dL + ELSE ! must be out of water + VOF0 = 0.0_DbKi + END IF + end if + + Lsum = Lsum + dL ! add length attributed to this node to the total + + ! get submerged cross sectional area and centroid for each node + z1hi = Rod%r(3,I) + 0.5*Rod%d*abs(sinPhi) ! highest elevation of cross section at node + z1lo = Rod%r(3,I) - 0.5*Rod%d*abs(sinPhi) ! lowest elevation of cross section at node + + if (z1lo > Rod%zeta(I)) then ! fully out of water + A = 0.0 ! area + zA = 0 ! centroid depth + else if (z1hi < Rod%zeta(I)) then ! fully submerged + A = Pi*0.25*Rod%d**2 + zA = Rod%r(3,I) + else ! if z1hi*z1lo < 0.0: # if cross section crosses waterplane + if (abs(sinPhi) < 0.001) then ! if cylinder is near vertical, i.e. end is horizontal + A = 0.5_DbKi ! <<< shouldn't this just be zero? <<< + zA = 0.0_DbKi + else + G = (Rod%r(3,I)-Rod%zeta(I))/abs(sinPhi) !(-z1lo+Rod%zeta(I))/abs(sinPhi) ! distance from node to waterline cross at same axial location [m] + !A = 0.25*Rod%d**2*acos((Rod%d - 2.0*G)/Rod%d) - (0.5*Rod%d-G)*sqrt(Rod%d*G-G**2) ! area of circular cross section that is below waterline [m^2] + !zA = (z1lo-Rod%zeta(I))/2 ! very crude approximation of centroid for now... <<< need to double check zeta bit <<< + al = acos(2.0*G/Rod%d) + A = Rod%d*Rod%d/8.0 * (2.0*al - sin(2.0*al)) + zA = Rod%r(3,I) - 0.6666666666 * Rod%d* (sin(al))**3 / (2.0*al - sin(2.0*al)) + end if + end if + + VOF = VOF0*cosPhi**2 + A/(0.25*Pi*Rod%d**2)*sinPhi**2 ! this is a more refined VOF-type measure that can work for any incline + + + ! build mass and added mass matrix + DO J=1,3 + DO K=1,3 + IF (J==K) THEN + Rod%M(K,J,I) = m_i + VOF*p%rhoW*v_i*( Rod%Can*(1 - Rod%q(J)*Rod%q(K)) + Rod%Cat*Rod%q(J)*Rod%q(K) ) + ELSE + Rod%M(K,J,I) = VOF*p%rhoW*v_i*( Rod%Can*(-Rod%q(J)*Rod%q(K)) + Rod%Cat*Rod%q(J)*Rod%q(K) ) + END IF + END DO + END DO + + ! <<<< what about accounting for offset of half segment from node location for end nodes? <<<< + + +! CALL Inverse3by3(Rod%S(:,:,I), Rod%M(:,:,I)) ! invert mass matrix + + + ! ------------------ CALCULATE FORCES ON EACH NODE ---------------------------- + + if (N > 0) then ! the following force calculations are only nonzero for finite-length rods (skipping for zero-length Rods) + + ! >>> no nodal axial elasticity loads calculated since it's assumed rigid, but should I calculate tension/compression due to other loads? <<< + + ! weight (now only the dry weight) + Rod%W(:,I) = (/ 0.0_DbKi, 0.0_DbKi, -m_i * p%g /) ! assuming g is positive + + ! radial buoyancy force from sides (now calculated based on outside pressure, for submerged portion only) + Ftemp = -VOF * v_i * p%rhoW*p%g * sinPhi ! magnitude of radial buoyancy force at this node + Rod%Bo(:,I) = (/ Ftemp*cosBeta*cosPhi, Ftemp*sinBeta*cosPhi, -Ftemp*sinPhi /) + + !relative flow velocities + DO J = 1, 3 + Vi(J) = Rod%U(J,I) - Rod%rd(J,I) ! relative flow velocity over node -- this is where wave velicites would be added + END DO + + ! decomponse relative flow into components + SumSqVp = 0.0_DbKi ! start sums of squares at zero + SumSqVq = 0.0_DbKi + DO J = 1, 3 + Vq(J) = DOT_PRODUCT( Vi , Rod%q ) * Rod%q(J); ! tangential relative flow component + Vp(J) = Vi(J) - Vq(J) ! transverse relative flow component + SumSqVq = SumSqVq + Vq(J)*Vq(J) + SumSqVp = SumSqVp + Vp(J)*Vp(J) + END DO + MagVp = sqrt(SumSqVp) ! get magnitudes of flow components + MagVq = sqrt(SumSqVq) + + ! transverse and tangenential drag + Rod%Dp(:,I) = VOF * 0.5*p%rhoW*Rod%Cdn* Rod%d* dL * MagVp * Vp + Rod%Dq(:,I) = 0.0_DbKi ! 0.25*p%rhoW*Rod%Cdt* Pi*Rod%d* dL * MagVq * Vq <<< should these axial side loads be included? + + ! fluid acceleration components for current node + aq = DOT_PRODUCT(Rod%Ud(:,I), Rod%q) * Rod%q ! tangential component of fluid acceleration + ap = Rod%Ud(:,I) - aq ! normal component of fluid acceleration + ! transverse and axial Froude-Krylov force + Rod%Ap(:,I) = VOF * p%rhoW*(1.0+Rod%Can)* v_i * ap ! + Rod%Aq(:,I) = 0.0_DbKi ! p%rhoW*(1.0+Rod%Cat)* v_i * aq ! <<< just put a taper-based term here eventually? + + ! dynamic pressure + Rod%Pd(:,I) = 0.0_DbKi ! assuming zero for sides for now, until taper comes into play + + ! seabed contact (stiffness and damping, vertical-only for now) + ! interpolate the local depth from the bathymetry grid + CALL getDepthFromBathymetry(m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, Rod%r(1,I), Rod%r(2,I), depth, nvec) + + IF (Rod%r(3,I) < -depth) THEN + Rod%B(3,I) = ( (-depth - Rod%r(3,I))*p%kBot - Rod%rd(3,I)*p%cBot) * Rod%d*dL + ELSE + Rod%B(1,I) = 0.0_DbKi + Rod%B(2,I) = 0.0_DbKi + Rod%B(3,I) = 0.0_DbKi + END IF + + ELSE ! zero-length (N=0) Rod case + + ! >>>>>>>>>>>>>> still need to check handling of zero length rods <<<<<<<<<<<<<<<<<<< + + ! for zero-length rods, make sure various forces are zero + Rod%W = 0.0_DbKi + Rod%Bo = 0.0_DbKi + Rod%Dp = 0.0_DbKi + Rod%Dq = 0.0_DbKi + Rod%Ap = 0.0_DbKi + Rod%Aq = 0.0_DbKi + Rod%Pd = 0.0_DbKi + Rod%B = 0.0_DbKi + + END IF + + + ! ------ now add forces, moments, and added mass from Rod end effects (these can exist even if N==0) ------- + + IF ((I==0) .and. (z1lo < Rod%zeta(I))) THEN ! if this is end A and it is at least partially submerged + + ! >>> eventually should consider a VOF approach for the ends hTilt = 0.5*Rod%d/cosPhi <<< + + ! buoyancy force + Ftemp = -VOF * 0.25*Pi*Rod%d*Rod%d * p%rhoW*p%g* zA + Rod%Bo(:,I) = Rod%Bo(:,I) + (/ Ftemp*cosBeta*sinPhi, Ftemp*sinBeta*sinPhi, Ftemp*cosPhi /) + + ! buoyancy moment + Mtemp = -VOF * 1.0/64.0*Pi*Rod%d**4 * p%rhoW*p%g * sinPhi + Rod%Mext = Rod%Mext + (/ Mtemp*sinBeta, -Mtemp*cosBeta, 0.0_DbKi /) + + ! axial drag + Rod%Dq(:,I) = Rod%Dq(:,I) + VOF * 0.25* Pi*Rod%d*Rod%d * p%rhoW*Rod%CdEnd * MagVq * Vq + + ! >>> what about rotational drag?? <<< eqn will be Pi* Rod%d**4/16.0 omega_rel?^2... *0.5 * Cd... + + ! Froud-Krylov force + Rod%Aq(:,I) = Rod%Aq(:,I) + VOF * p%rhoW*(1.0+Rod%CaEnd)* (2.0/3.0*Pi*Rod%d**3 /8.0) * aq + + ! dynamic pressure force + Rod%Pd(:,I) = Rod%Pd(:,I) + VOF * 0.25* Pi*Rod%d*Rod%d * Rod%PDyn(I) * Rod%q + + ! added mass + DO J=1,3 + DO K=1,3 + Rod%M(K,J,I) = Rod%M(K,J,I) + VOF*p%rhoW* Rod%CaEnd* (2.0/3.0*Pi*Rod%d**3 /8.0) *Rod%q(J)*Rod%q(K) + END DO + END DO + + END IF + + IF ((I==N) .and. (z1lo < Rod%zeta(I))) THEN ! if this end B and it is at least partially submerged (note, if N=0, both this and previous if statement are true) + + ! buoyancy force + Ftemp = VOF * 0.25*Pi*Rod%d*Rod%d * p%rhoW*p%g* zA + Rod%Bo(:,I) = Rod%Bo(:,I) + (/ Ftemp*cosBeta*sinPhi, Ftemp*sinBeta*sinPhi, Ftemp*cosPhi /) + + ! buoyancy moment + Mtemp = VOF * 1.0/64.0*Pi*Rod%d**4 * p%rhoW*p%g * sinPhi + Rod%Mext = Rod%Mext + (/ Mtemp*sinBeta, -Mtemp*cosBeta, 0.0_DbKi /) + + ! axial drag + Rod%Dq(:,I) = Rod%Dq(:,I) + VOF * 0.25* Pi*Rod%d*Rod%d * p%rhoW*Rod%CdEnd * MagVq * Vq + + ! Froud-Krylov force + Rod%Aq(:,I) = Rod%Aq(:,I) + VOF * p%rhoW*(1.0+Rod%CaEnd)* (2.0/3.0*Pi*Rod%d**3 /8.0) * aq + + ! dynamic pressure force + Rod%Pd(:,I) = Rod%Pd(:,I) - VOF * 0.25* Pi*Rod%d*Rod%d * Rod%PDyn(I) * Rod%q + + ! added mass + DO J=1,3 + DO K=1,3 + Rod%M(K,J,I) = Rod%M(K,J,I) + VOF*p%rhoW* Rod%CaEnd* (2.0/3.0*Pi*Rod%d**3 /8.0) *Rod%q(J)*Rod%q(K) + END DO + END DO + + END IF + + + ! ---------------------------- total forces for this node ----------------------------- + + Rod%Fnet(:,I) = Rod%W(:,I) + Rod%Bo(:,I) + Rod%Dp(:,I) + Rod%Dq(:,I) & + + Rod%Ap(:,I) + Rod%Aq(:,I) + Rod%Pd(:,I) + Rod%B(:,I) + + + END DO ! I - done looping through nodes + + + ! ----- add waterplane moment of inertia moment if applicable ----- + IF ((Rod%r(3,0) < zeta) .and. (Rod%r(3,N) > zeta)) then ! check if it's crossing the water plane <<< may need updating + ! >>> could scale the below based on whether part of the end cap is crossing the water plane... + !Mtemp = 1.0/16.0 *Pi*Rod%d**4 * p%rhoW*p%g * sinPhi * (1.0 + 0.5* tanPhi**2) ! original (goes to infinity at 90 deg) + Mtemp = 1.0/16.0 *Pi*Rod%d**4 * p%rhoW*p%g * sinPhi * cosPhi ! simple alternative that goes to 0 at 90 deg then reverses sign beyond that + Rod%Mext = Rod%Mext + (/ Mtemp*sinBeta, -Mtemp*cosBeta, 0.0_DbKi /) + END IF + + + ! ---------------- now add in forces on end nodes from attached lines ------------------ + + ! zero the external force/moment sums (important!) + + ! loop through lines attached to end A + Rod%FextA = 0.0_DbKi + DO l=1,Rod%nAttachedA + + CALL Line_GetEndStuff(m%LineList(Rod%attachedA(l)), Fnet_i, Mnet_i, Mass_i, Rod%TopA(l)) + + ! sum quantitites + Rod%Fnet(:,0)= Rod%Fnet(:,0) + Fnet_i ! total force + Rod%FextA = Rod%FextA + Fnet_i ! a copy for outputting totalled line loads + Rod%Mext = Rod%Mext + Mnet_i ! externally applied moment + Rod%M(:,:,0) = Rod%M(:,:,0) + Mass_i ! mass at end node + + END DO + + ! loop through lines attached to end B + Rod%FextB = 0.0_DbKi + DO l=1,Rod%nAttachedB + + CALL Line_GetEndStuff(m%LineList(Rod%attachedB(l)), Fnet_i, Mnet_i, Mass_i, Rod%TopB(l)) + + ! sum quantitites + Rod%Fnet(:,N)= Rod%Fnet(:,N) + Fnet_i ! total force + Rod%FextB = Rod%FextB + Fnet_i ! a copy for outputting totalled line loads + Rod%Mext = Rod%Mext + Mnet_i ! externally applied moment + Rod%M(:,:,N) = Rod%M(:,:,N) + Mass_i ! mass at end node + + END DO + + ! ---------------- now lump everything in 6DOF about end A ----------------------------- + + ! question: do I really want to neglect the rotational inertia/drag/etc across the length of each segment? + + ! make sure 6DOF quantiaties are zeroed before adding them up + Rod%F6net = 0.0_DbKi + Rod%M6net = 0.0_DbKi + + ! now go through each node's contributions, put them about end A, and sum them + DO i = 0,Rod%N + + rRel = Rod%r(:,i) - Rod%r(:,0) ! vector from reference point to node + + ! convert segment net force into 6dof force about body ref point (if the Rod itself, end A) + CALL translateForce3to6DOF(rRel, Rod%Fnet(:,i), F6_i) + + ! convert segment mass matrix to 6by6 mass matrix about body ref point (if the Rod itself, end A) + CALL translateMass3to6DOF(rRel, Rod%M(:,:,i), M6_i) + + ! sum contributions + Rod%F6net = Rod%F6net + F6_i + Rod%M6net = Rod%M6net + M6_i + + END DO + + ! ------------- Calculate some items for the Rod as a whole here ----------------- + + ! >>> could some of these be precalculated just once? <<< + + ! add inertia terms for the Rod assuming it is uniform density (radial terms add to existing matrix which contains parallel-axis-theorem components only) + Imat_l = 0.0_DbKi + if (Rod%N > 0) then + I_l = 0.125*Rod%mass * Rod%d*Rod%d ! axial moment of inertia + I_r = Rod%mass/12 * (0.75*Rod%d*Rod%d + (Rod%UnstrLen/Rod%N)**2 ) * Rod%N ! summed radial moment of inertia for each segment individually + + Imat_l(1,1) = I_r ! inertia about CG in local orientations (as if Rod is vertical) + Imat_l(2,2) = I_r + Imat_l(3,3) = I_l + end if + + ! >>> 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 + + ! 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 + + + ! now add centripetal and gyroscopic forces/moments, and that should be everything + h_c = 0.5*Rod%UnstrLen ! distance to center of mass + 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 !<<>> do we need to ensure zero moment is passed if it's pinned? <<< + !if (abs(Rod%typeNum)==1) then + ! Fnet_out(4:6) = 0.0_DbKi + !end if + + + END SUBROUTINE Rod_GetNetForceAndMass + !-------------------------------------------------------------- + + + ! this function handles assigning a line to a connection node + SUBROUTINE Rod_AddLine(Rod, lineID, TopOfLine, endB) + + Type(MD_Rod), INTENT (INOUT) :: Rod ! the Connection object + + Integer(IntKi), INTENT( IN ) :: lineID + Integer(IntKi), INTENT( IN ) :: TopOfLine + Integer(IntKi), INTENT( IN ) :: endB ! add line to end B if 1, end A if 0 + + if (endB==1) then ! attaching to end B + + IF (wordy > 0) Print*, "L", lineID, "->R", Rod%IdNum , "b" + + IF (Rod%nAttachedB <10) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + Rod%nAttachedB = Rod%nAttachedB + 1 ! add the line to the number connected + Rod%AttachedB(Rod%nAttachedB) = lineID + Rod%TopB(Rod%nAttachedB) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) + ELSE + Print*, "too many lines connected to Rod ", Rod%IdNum, " in MoorDyn!" + END IF + + else ! attaching to end A + + IF (wordy > 0) Print*, "L", lineID, "->R", Rod%IdNum , "a" + + IF (Rod%nAttachedA <10) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + Rod%nAttachedA = Rod%nAttachedA + 1 ! add the line to the number connected + Rod%AttachedA(Rod%nAttachedA) = lineID + Rod%TopA(Rod%nAttachedA) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) + ELSE + Print*, "too many lines connected to Rod ", Rod%IdNum, " in MoorDyn!" + END IF + + end if + + END SUBROUTINE Rod_AddLine + + + ! this function handles removing a line from a connection node + SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) + + Type(MD_Rod), INTENT (INOUT) :: Rod ! the Connection object + + Integer(IntKi), INTENT( IN ) :: lineID + Integer(IntKi), INTENT( OUT) :: TopOfLine + Integer(IntKi), INTENT( IN ) :: endB ! end B if 1, end A if 0 + REAL(DbKi), INTENT(INOUT) :: rEnd(3) + REAL(DbKi), INTENT(INOUT) :: rdEnd(3) + + Integer(IntKi) :: l,m,J + + if (endB==1) then ! attaching to end B + + DO l = 1,Rod%nAttachedB ! look through attached lines + + IF (Rod%AttachedB(l) == lineID) THEN ! if this is the line's entry in the attachment list + + TopOfLine = Rod%TopB(l); ! record which end of the line was attached + + DO m = l,Rod%nAttachedB-1 + + 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) + + Rod%nAttachedB = Rod%nAttachedB - 1 ! reduce attached line counter by 1 + + ! also pass back the kinematics at the end + DO J = 1,3 + rEnd( J) = Rod%r( J,Rod%N) + rdEnd(J) = Rod%rd(J,Rod%N) + END DO + + print*, "Detached line ", lineID, " from Rod ", 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 + END IF + END DO + + else ! attaching to end A + + DO l = 1,Rod%nAttachedA ! look through attached lines + + IF (Rod%AttachedA(l) == lineID) THEN ! if this is the line's entry in the attachment list + + TopOfLine = Rod%TopA(l); ! record which end of the line was attached + + DO m = l,Rod%nAttachedA-1 + + 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) + + Rod%nAttachedA = Rod%nAttachedA - 1 ! reduce attached line counter by 1 + + ! also pass back the kinematics at the end + DO J = 1,3 + rEnd( J) = Rod%r( J,0) + rdEnd(J) = Rod%rd(J,0) + END DO + + print*, "Detached line ", lineID, " from Rod ", 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 + END IF + END DO + + end if + + END SUBROUTINE Rod_RemoveLine + + + + +END MODULE MoorDyn_Rod diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 242c7fee18..b35edada02 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -33,46 +33,116 @@ MODULE MoorDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE +! ========= MD_InputFileType ======= + TYPE, PUBLIC :: MD_InputFileType + REAL(DbKi) :: DTIC = 0.5 !< convergence check time step for IC generation [[s]] + REAL(DbKi) :: TMaxIC = 120 !< maximum time to allow for getting converged ICs [[s]] + REAL(ReKi) :: CdScaleIC = 1 !< factor to scale drag coefficients by during dynamic relaxation [[]] + REAL(ReKi) :: threshIC = 0.01 !< convergence tolerance for ICs (0.01 means 1%) [[]] + END TYPE MD_InputFileType +! ======================= ! ========= MD_InitInputType ======= TYPE, PUBLIC :: MD_InitInputType REAL(ReKi) :: g = -999.9 !< gravity constant [[m/s^2]] REAL(ReKi) :: rhoW = -999.9 !< sea density [[kg/m^3]] REAL(ReKi) :: WtrDepth = -999.9 !< depth of water [[m]] - REAL(ReKi) , DIMENSION(1:6) :: PtfmInit !< initial position of platform [-] + 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]] 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? [-] - REAL(ReKi) :: DTIC !< convergence check time step for IC generation [[s]] - REAL(ReKi) :: TMaxIC = 120 !< maximum time to allow for getting converged ICs [[s]] - REAL(ReKi) :: CdScaleIC = 1 !< factor to scale drag coefficients by during dynamic relaxation [[]] - REAL(ReKi) :: threshIC = 0.01 !< convergence tolerance for ICs (0.01 means 1%) [[]] 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. [-] + 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 [-] - CHARACTER(10) :: name !< name/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 !< stiffness [[N]] + 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 [-] END TYPE MD_LineProp ! ======================= +! ========= MD_RodProp ======= + TYPE, PUBLIC :: MD_RodProp + INTEGER(IntKi) :: IdNum !< 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 [[-]] + END TYPE MD_RodProp +! ======================= +! ========= MD_Body ======= + TYPE, PUBLIC :: MD_Body + INTEGER(IntKi) :: IdNum !< integer identifier of this Connection [-] + INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC !< list of IdNums of connections 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 connections [-] + INTEGER(IntKi) :: nAttachedR = 0 !< number of attached rods [-] + REAL(DbKi) , DIMENSION(1:3,1:30) :: rConnectRel !< relative position of connection on body [-] + REAL(DbKi) , DIMENSION(1:6,1:30) :: r6RodRel !< relative position and orientation of rod on body [-] + REAL(DbKi) :: bodyM !< [-] + REAL(DbKi) :: bodyV !< [-] + REAL(DbKi) , DIMENSION(1:3) :: bodyI !< [-] + REAL(DbKi) , DIMENSION(1:6) :: bodyCdA !< product of drag force and frontal area of connection point [[m^2]] + REAL(DbKi) , DIMENSION(1:6) :: bodyCa !< added mass coefficient of connection point [-] + 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..) [-] + END TYPE MD_Body +! ======================= ! ========= MD_Connect ======= TYPE, PUBLIC :: MD_Connect INTEGER(IntKi) :: IdNum !< integer identifier of this Connection [-] CHARACTER(10) :: type !< type of Connect: fix, vessel, connect [-] - INTEGER(IntKi) :: TypeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AttachedFairs !< list of IdNums of connected Line tops [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AttachedAnchs !< list of IdNums of connected Line bottoms [-] - REAL(DbKi) :: conX !< [-] - REAL(DbKi) :: conY !< [-] - REAL(DbKi) :: conZ !< [-] + INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Attached !< list of IdNums of lines attached to this connection 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) :: conM !< [-] REAL(DbKi) :: conV !< [-] REAL(DbKi) :: conFX !< [-] @@ -80,33 +150,129 @@ MODULE MoorDyn_Types REAL(DbKi) :: conFZ !< [-] REAL(DbKi) :: conCa !< added mass coefficient of connection point [-] REAL(DbKi) :: conCdA !< product of drag force and frontal area of connection point [[m^2]] - REAL(DbKi) , DIMENSION(1:3) :: Ftot !< total force on node [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: Mtot !< node mass matrix, from attached lines [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: S !< inverse mass matrix [[kg]] + 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]] + 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 [-] END TYPE MD_Connect ! ======================= +! ========= MD_Rod ======= + TYPE, PUBLIC :: MD_Rod + INTEGER(IntKi) :: IdNum !< 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=connect [-] + 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 connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] + INTEGER(IntKi) :: endTypeB !< type of connection at end B: 0=pinned to Connection, 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 [deg] + REAL(DbKi) :: pitch !< pitch relative to vertical [deg] + REAL(DbKi) :: h0 !< 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(:), 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]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Ud !< water acceleration at node [[m/s^2]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: zeta !< water surface elevation above node [[m]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: PDyn !< water dynamic pressure at node [[Pa]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: W !< weight vectors [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Bo !< buoyancy force vectors [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Pd !< dynamic pressure force vectors [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Dp !< node drag (transverse) [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Dq !< node drag (axial) [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Ap !< node added mass forcing (transverse) [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Aq !< node added mass forcing (axial) [[N]] + 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(:), 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 [-] - CHARACTER(10) :: type !< type of line. should match one of LineProp names [-] + 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 !< index of control channel that will drive line active tensioning (0 for none) [-] + INTEGER(IntKi) :: CtrlChan = 0 !< index of control channel that will drive line active tensioning (0 for none) [-] INTEGER(IntKi) :: FairConnect !< IdNum of Connection at fairlead [-] INTEGER(IntKi) :: AnchConnect !< IdNum of Connection at anchor [-] - INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated line properties [-] INTEGER(IntKi) :: N !< The number of elements in the line [-] + INTEGER(IntKi) :: endTypeA !< type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] + INTEGER(IntKi) :: endTypeB !< type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod. [-] REAL(DbKi) :: UnstrLen !< unstretched length of the line [-] - REAL(DbKi) :: BA !< internal damping coefficient times area for this line only [[N-s]] + 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]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: r !< node positions [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: rd !< node velocities [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: q !< node tangent vectors [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: qs !< segment tangent vectors [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: l !< segment unstretched length [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: ld !< segment unstretched length rate of change (used in active tensioning) [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: lstr !< segment stretched length [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: lstrd !< segment change in stretched length [[m/s]] + 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 :: 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]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: PDyn !< water dynamic pressure at node [[Pa]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: T !< segment tension vectors [[N]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Td !< segment internal damping force vectors [[N]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: W !< weight/buoyancy vectors [[N]] @@ -115,17 +281,25 @@ MODULE MoorDyn_Types REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Ap !< node added mass forcing (transverse) [[N]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Aq !< node added mass forcing (axial) [[N]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: B !< node bottom contact force [[N]] - REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: F !< total force on node [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Bs !< node force due to bending moments [[N]] + 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(ReKi) , DIMENSION(:), ALLOCATABLE :: LineWrOutput !< one row of output data for this line [-] + 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 [-] + END TYPE MD_Fail +! ======================= ! ========= MD_OutParmType ======= TYPE, PUBLIC :: MD_OutParmType - CHARACTER(ChanLen) :: Name !< name of output channel [-] - CHARACTER(ChanLen) :: Units !< units string [-] + 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=connect [-] INTEGER(IntKi) :: NodeID !< node number if OType=0. 0=anchor, -1=N=Fairlead [-] @@ -138,11 +312,19 @@ MODULE MoorDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: writeOutputUnt !< second line of output file contents: units [-] TYPE(ProgDesc) :: Ver !< this module's name, version, and date [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: CableCChanRqst !< flag indicating control channel for drive line active tensioning is requested [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue) [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] END TYPE MD_InitOutputType ! ======================= ! ========= MD_ContinuousStateType ======= TYPE, PUBLIC :: MD_ContinuousStateType - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: states !< full list of node coordinates and velocities [[m] or [m/s]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: states !< state vector of mooring system, e.g. node coordinates and velocities [] END TYPE MD_ContinuousStateType ! ======================= ! ========= MD_DiscreteStateType ======= @@ -163,50 +345,291 @@ MODULE MoorDyn_Types ! ========= MD_MiscVarType ======= TYPE, PUBLIC :: MD_MiscVarType TYPE(MD_LineProp) , DIMENSION(:), ALLOCATABLE :: LineTypeList !< array of properties for each line type [-] - TYPE(MD_Connect) , DIMENSION(:), ALLOCATABLE :: ConnectList !< array of connection properties [-] - TYPE(MD_Line) , DIMENSION(:), ALLOCATABLE :: LineList !< array of line properties [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FairIdList !< array of size NFairs listing the ID of each fairlead (index of ConnectList) [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ConnIdList !< array of size NConnss listing the ID of each connect type connection (index of ConnectList) [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIndList !< starting index of each line's states in state vector [] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MDWrOutput !< Data from time step to be written to a MoorDyn output file [-] + TYPE(MD_RodProp) , DIMENSION(:), ALLOCATABLE :: RodTypeList !< array of properties for each rod type [-] + TYPE(MD_Body) :: GroundBody !< the single ground body which is the parent of all stationary connections [-] + TYPE(MD_Body) , DIMENSION(:), ALLOCATABLE :: BodyList !< array of body objects [-] + TYPE(MD_Rod) , DIMENSION(:), ALLOCATABLE :: RodList !< array of rod objects [-] + TYPE(MD_Connect) , DIMENSION(:), ALLOCATABLE :: ConnectList !< array of connection objects [-] + TYPE(MD_Line) , DIMENSION(:), ALLOCATABLE :: LineList !< array of line objects [-] + TYPE(MD_Fail) , DIMENSION(:), ALLOCATABLE :: FailList !< array of line objects [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeConIs !< array of free connection indices in ConnectList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldConIs !< array of coupled/fairlead connection indices in ConnectList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeRodIs !< array of free rod indices in RodList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldRodIs !< array of coupled/fairlead rod indices in RodList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeBodyIs !< array of free body indices in BodyList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldBodyIs !< array of coupled body indices in BodyList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIs1 !< starting index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIsN !< ending index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ConStateIs1 !< starting index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ConStateIsN !< ending index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIs1 !< starting index of each rod's states in state vector [] + 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 [] + 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(:), 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) , 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 [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_npoints !< number of grid points to describe the bathymetry grid [-] END TYPE MD_MiscVarType ! ======================= ! ========= MD_ParameterType ======= TYPE, PUBLIC :: MD_ParameterType - INTEGER(IntKi) :: NTypes !< number of line types [] - INTEGER(IntKi) :: NConnects !< number of Connection objects [] - INTEGER(IntKi) :: NFairs !< number of Fairlead Connections [] - INTEGER(IntKi) :: NConns !< number of Connect type Connections - not to be confused with NConnects [] - INTEGER(IntKi) :: NAnchs !< number of Anchor type Connections [] - INTEGER(IntKi) :: NLines !< number of Line objects [] - REAL(ReKi) :: g = 9.81 !< gravitational constant [[kg/m^2]] - REAL(ReKi) :: rhoW !< density of seawater [[m]] - REAL(ReKi) :: WtrDpth !< water depth [[m]] - REAL(ReKi) :: kBot !< bottom stiffness [[Pa/m]] - REAL(ReKi) :: cBot !< bottom damping [[Pa-s/m]] - REAL(ReKi) :: dtM0 !< desired mooring model time step [[s]] - REAL(ReKi) :: dtCoupling !< coupling time step that MoorDyn should expect [[s]] + INTEGER(IntKi) :: nLineTypes = 0 !< number of line types [] + INTEGER(IntKi) :: nRodTypes = 0 !< number of rod types [] + INTEGER(IntKi) :: nConnects = 0 !< number of Connection objects [] + INTEGER(IntKi) :: nConnectsExtra = 0 !< number of Connection objects including space for extra ones that could arise from line failures [] + INTEGER(IntKi) :: nBodies = 0 !< number of Body objects [] + INTEGER(IntKi) :: nRods = 0 !< number of Rod objects [] + INTEGER(IntKi) :: nLines = 0 !< number of Line objects [] + INTEGER(IntKi) :: nCtrlChans = 0 !< number of distinct control channels specified for use as inputs [] + INTEGER(IntKi) :: nFails = 0 !< number of failure conditions [] + INTEGER(IntKi) :: nFreeBodies = 0 !< [] + INTEGER(IntKi) :: nFreeRods = 0 !< [] + INTEGER(IntKi) :: nFreeCons = 0 !< [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: nCpldBodies !< number of coupled bodies (for FAST.Farm, size>1 with an entry for each turbine) [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: nCpldRods !< number of coupled rods (for FAST.Farm, size>1 with an entry for each turbine) [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: nCpldCons !< number of coupled points (for FAST.Farm, size>1 with an entry for each turbine) [] + INTEGER(IntKi) :: NConns = 0 !< number of Connect type Connections - not to be confused with NConnects [] + INTEGER(IntKi) :: NAnchs = 0 !< number of Anchor type Connections [] + REAL(DbKi) :: Tmax !< 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]] 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 [-] + 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 [-] + 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(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) , 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 [-] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: axWave !< wave accelerations time series at each grid point [-] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: ayWave !< wave accelerations time series at each grid point [-] + 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 [-] + 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) , 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) , DIMENSION(:), ALLOCATABLE :: dxIdx_map2_xStateIdx !< Mapping array from index of dX array to corresponding state index [-] END TYPE MD_ParameterType ! ======================= ! ========= MD_InputType ======= TYPE, PUBLIC :: MD_InputType - TYPE(MeshType) :: PtFairleadDisplacement !< mesh for position AND VELOCITY of each fairlead in X,Y,Z [[m, m/s]] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: CoupledKinematics !< array of meshes for each coupling point (6 DOF info used for rods and bodies) [[m, m/s]] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DeltaL !< change in line length command for each channel [[m]] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DeltaLdot !< rate of change of line length command for each channel [[m]] END TYPE MD_InputType ! ======================= ! ========= MD_OutputType ======= TYPE, PUBLIC :: MD_OutputType - TYPE(MeshType) :: PtFairleadLoad !< point mesh for fairlead forces in X,Y,Z [[N]] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: CoupledLoads !< array of point meshes for mooring reaction forces (and moments) at coupling points [[N]] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< output vector returned to glue code [] 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 @@ -227,14 +650,43 @@ SUBROUTINE MD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt 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 - DstInitInputData%DTIC = SrcInitInputData%DTIC - DstInitInputData%TMaxIC = SrcInitInputData%TMaxIC - DstInitInputData%CdScaleIC = SrcInitInputData%CdScaleIC - DstInitInputData%threshIC = SrcInitInputData%threshIC IF (ALLOCATED(SrcInitInputData%OutList)) THEN i1_l = LBOUND(SrcInitInputData%OutList,1) i1_u = UBOUND(SrcInitInputData%OutList,1) @@ -246,20 +698,128 @@ SUBROUTINE MD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt END IF END IF DstInitInputData%OutList = SrcInitInputData%OutList +ENDIF + DstInitInputData%Linearize = SrcInitInputData%Linearize +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 ) + SUBROUTINE MD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInitInput' + LOGICAL,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 @@ -301,18 +861,70 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg 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 - Re_BufSz = Re_BufSz + 1 ! DTIC - Re_BufSz = Re_BufSz + 1 ! TMaxIC - Re_BufSz = Re_BufSz + 1 ! CdScaleIC - Re_BufSz = Re_BufSz + 1 ! threshIC 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 ! 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 ) @@ -347,35 +959,97 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WtrDepth Re_Xferred = Re_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 - 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%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TMaxIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CdScaleIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%threshIC - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN + 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%OutList,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 @@ -385,6 +1059,113 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg 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 + 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 @@ -423,12 +1204,56 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = Re_Xferred + 1 OutData%WtrDepth = ReKiBuf(Re_Xferred) Re_Xferred = Re_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 ! 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 @@ -437,16 +1262,50 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err 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 - OutData%DTIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TMaxIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CdScaleIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%threshIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -467,56 +1326,204 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err END DO ! I 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) :: 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%BA = SrcLinePropData%BA - DstLinePropData%Can = SrcLinePropData%Can - DstLinePropData%Cat = SrcLinePropData%Cat - DstLinePropData%Cdn = SrcLinePropData%Cdn - DstLinePropData%Cdt = SrcLinePropData%Cdt - END SUBROUTINE MD_CopyLineProp - - 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' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - 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 + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + 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 @@ -546,11 +1553,24 @@ SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 @@ -590,8 +1610,14 @@ SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 @@ -600,6 +1626,38 @@ SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 ) @@ -615,6 +1673,7 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred 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' @@ -640,8 +1699,14 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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) @@ -650,90 +1715,106 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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_CopyConnect( SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Connect), INTENT(IN) :: SrcConnectData - TYPE(MD_Connect), INTENT(INOUT) :: DstConnectData + 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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - 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_CopyConnect' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyRodProp' ! ErrStat = ErrID_None ErrMsg = "" - DstConnectData%IdNum = SrcConnectData%IdNum - DstConnectData%type = SrcConnectData%type - DstConnectData%TypeNum = SrcConnectData%TypeNum -IF (ALLOCATED(SrcConnectData%AttachedFairs)) THEN - i1_l = LBOUND(SrcConnectData%AttachedFairs,1) - i1_u = UBOUND(SrcConnectData%AttachedFairs,1) - IF (.NOT. ALLOCATED(DstConnectData%AttachedFairs)) THEN - ALLOCATE(DstConnectData%AttachedFairs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConnectData%AttachedFairs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstConnectData%AttachedFairs = SrcConnectData%AttachedFairs -ENDIF -IF (ALLOCATED(SrcConnectData%AttachedAnchs)) THEN - i1_l = LBOUND(SrcConnectData%AttachedAnchs,1) - i1_u = UBOUND(SrcConnectData%AttachedAnchs,1) - IF (.NOT. ALLOCATED(DstConnectData%AttachedAnchs)) THEN - ALLOCATE(DstConnectData%AttachedAnchs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConnectData%AttachedAnchs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstConnectData%AttachedAnchs = SrcConnectData%AttachedAnchs -ENDIF - DstConnectData%conX = SrcConnectData%conX - DstConnectData%conY = SrcConnectData%conY - DstConnectData%conZ = SrcConnectData%conZ - DstConnectData%conM = SrcConnectData%conM - DstConnectData%conV = SrcConnectData%conV - DstConnectData%conFX = SrcConnectData%conFX - DstConnectData%conFY = SrcConnectData%conFY - DstConnectData%conFZ = SrcConnectData%conFZ - DstConnectData%conCa = SrcConnectData%conCa - DstConnectData%conCdA = SrcConnectData%conCdA - DstConnectData%Ftot = SrcConnectData%Ftot - DstConnectData%Mtot = SrcConnectData%Mtot - DstConnectData%S = SrcConnectData%S - DstConnectData%r = SrcConnectData%r - DstConnectData%rd = SrcConnectData%rd - END SUBROUTINE MD_CopyConnect - - SUBROUTINE MD_DestroyConnect( ConnectData, ErrStat, ErrMsg ) - TYPE(MD_Connect), INTENT(INOUT) :: ConnectData + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyConnect' + LOGICAL,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 (ALLOCATED(ConnectData%AttachedFairs)) THEN - DEALLOCATE(ConnectData%AttachedFairs) -ENDIF -IF (ALLOCATED(ConnectData%AttachedAnchs)) THEN - DEALLOCATE(ConnectData%AttachedAnchs) -ENDIF - END SUBROUTINE MD_DestroyConnect - SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + 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_Connect), INTENT(IN) :: InData + TYPE(MD_RodProp), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -748,7 +1829,7 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackConnect' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackRodProp' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -765,33 +1846,15 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 + 1 ! AttachedFairs allocated yes/no - IF ( ALLOCATED(InData%AttachedFairs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AttachedFairs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AttachedFairs) ! AttachedFairs - END IF - Int_BufSz = Int_BufSz + 1 ! AttachedAnchs allocated yes/no - IF ( ALLOCATED(InData%AttachedAnchs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AttachedAnchs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AttachedAnchs) ! AttachedAnchs - END IF - Db_BufSz = Db_BufSz + 1 ! conX - Db_BufSz = Db_BufSz + 1 ! conY - Db_BufSz = Db_BufSz + 1 ! conZ - Db_BufSz = Db_BufSz + 1 ! conM - Db_BufSz = Db_BufSz + 1 ! conV - Db_BufSz = Db_BufSz + 1 ! conFX - Db_BufSz = Db_BufSz + 1 ! conFY - Db_BufSz = Db_BufSz + 1 ! conFZ - Db_BufSz = Db_BufSz + 1 ! conCa - Db_BufSz = Db_BufSz + 1 ! conCdA - Db_BufSz = Db_BufSz + SIZE(InData%Ftot) ! Ftot - Db_BufSz = Db_BufSz + SIZE(InData%Mtot) ! Mtot - Db_BufSz = Db_BufSz + SIZE(InData%S) ! S - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd + 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 @@ -821,93 +1884,340 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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) + 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%TypeNum - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AttachedFairs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AttachedFairs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AttachedFairs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AttachedFairs,1), UBOUND(InData%AttachedFairs,1) - IntKiBuf(Int_Xferred) = InData%AttachedFairs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AttachedAnchs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AttachedAnchs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AttachedAnchs,1) - Int_Xferred = Int_Xferred + 2 + 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 - DO i1 = LBOUND(InData%AttachedAnchs,1), UBOUND(InData%AttachedAnchs,1) - IntKiBuf(Int_Xferred) = InData%AttachedAnchs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%conX + 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 - DbKiBuf(Db_Xferred) = InData%conY + OutData%w = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conZ + OutData%Can = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conM + OutData%Cat = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conV + OutData%Cdn = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFX + OutData%Cdt = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFY + OutData%CdEnd = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFZ + OutData%CaEnd = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conCa + 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%rConnectRel = SrcBodyData%rConnectRel + 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%rConnectRel) ! rConnectRel + 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%rConnectRel,2), UBOUND(InData%rConnectRel,2) + DO i1 = LBOUND(InData%rConnectRel,1), UBOUND(InData%rConnectRel,1) + DbKiBuf(Db_Xferred) = InData%rConnectRel(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%conCdA + 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%Ftot,1), UBOUND(InData%Ftot,1) - DbKiBuf(Db_Xferred) = InData%Ftot(i1) + 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%Mtot,2), UBOUND(InData%Mtot,2) - DO i1 = LBOUND(InData%Mtot,1), UBOUND(InData%Mtot,1) - DbKiBuf(Db_Xferred) = InData%Mtot(i1,i2) + 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%S,2), UBOUND(InData%S,2) - DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) - DbKiBuf(Db_Xferred) = InData%S(i1,i2) + 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 i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1) - Db_Xferred = Db_Xferred + 1 + 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 i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1) + 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_PackConnect + END SUBROUTINE MD_PackBody - SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + 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_Connect), INTENT(INOUT) :: OutData + TYPE(MD_Body), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -920,7 +2230,7 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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_UnPackConnect' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackBody' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -933,111 +2243,157 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) + OutData%typeNum = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AttachedFairs not allocated + 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 - ELSE + OutData%nAttachedR = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AttachedFairs)) DEALLOCATE(OutData%AttachedFairs) - ALLOCATE(OutData%AttachedFairs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AttachedFairs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AttachedFairs,1), UBOUND(OutData%AttachedFairs,1) - OutData%AttachedFairs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%rConnectRel,1) + i1_u = UBOUND(OutData%rConnectRel,1) + i2_l = LBOUND(OutData%rConnectRel,2) + i2_u = UBOUND(OutData%rConnectRel,2) + DO i2 = LBOUND(OutData%rConnectRel,2), UBOUND(OutData%rConnectRel,2) + DO i1 = LBOUND(OutData%rConnectRel,1), UBOUND(OutData%rConnectRel,1) + OutData%rConnectRel(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AttachedAnchs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AttachedAnchs)) DEALLOCATE(OutData%AttachedAnchs) - ALLOCATE(OutData%AttachedAnchs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AttachedAnchs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AttachedAnchs,1), UBOUND(OutData%AttachedAnchs,1) - OutData%AttachedAnchs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + 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 IF - OutData%conX = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conY = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conZ = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conM = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conV = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conFX = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conFY = DbKiBuf(Db_Xferred) + END DO + OutData%bodyM = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - OutData%conFZ = DbKiBuf(Db_Xferred) + OutData%bodyV = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - OutData%conCa = DbKiBuf(Db_Xferred) + 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 - OutData%conCdA = DbKiBuf(Db_Xferred) + 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%Ftot,1) - i1_u = UBOUND(OutData%Ftot,1) - DO i1 = LBOUND(OutData%Ftot,1), UBOUND(OutData%Ftot,1) - OutData%Ftot(i1) = DbKiBuf(Db_Xferred) + 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%Mtot,1) - i1_u = UBOUND(OutData%Mtot,1) - i2_l = LBOUND(OutData%Mtot,2) - i2_u = UBOUND(OutData%Mtot,2) - DO i2 = LBOUND(OutData%Mtot,2), UBOUND(OutData%Mtot,2) - DO i1 = LBOUND(OutData%Mtot,1), UBOUND(OutData%Mtot,1) - OutData%Mtot(i1,i2) = DbKiBuf(Db_Xferred) + 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%S,1) - i1_u = UBOUND(OutData%S,1) - i2_l = LBOUND(OutData%S,2) - i2_u = UBOUND(OutData%S,2) - DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) - DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) - OutData%S(i1,i2) = DbKiBuf(Db_Xferred) + 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%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 + 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%rd,1) - i1_u = UBOUND(OutData%rd,1) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1) = DbKiBuf(Db_Xferred) + 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_UnPackConnect + END SUBROUTINE MD_UnPackBody - SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Line), INTENT(IN) :: SrcLineData - TYPE(MD_Line), INTENT(INOUT) :: DstLineData + SUBROUTINE MD_CopyConnect( SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_Connect), INTENT(IN) :: SrcConnectData + TYPE(MD_Connect), INTENT(INOUT) :: DstConnectData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -1045,374 +2401,781 @@ SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) 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' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyConnect' ! ErrStat = ErrID_None ErrMsg = "" - DstLineData%IdNum = SrcLineData%IdNum - DstLineData%type = SrcLineData%type - DstLineData%OutFlagList = SrcLineData%OutFlagList - DstLineData%CtrlChan = SrcLineData%CtrlChan - DstLineData%FairConnect = SrcLineData%FairConnect - DstLineData%AnchConnect = SrcLineData%AnchConnect - DstLineData%PropsIdNum = SrcLineData%PropsIdNum - DstLineData%N = SrcLineData%N - DstLineData%UnstrLen = SrcLineData%UnstrLen - DstLineData%BA = SrcLineData%BA -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) + DstConnectData%IdNum = SrcConnectData%IdNum + DstConnectData%type = SrcConnectData%type + DstConnectData%typeNum = SrcConnectData%typeNum + DstConnectData%Attached = SrcConnectData%Attached + DstConnectData%Top = SrcConnectData%Top + DstConnectData%nAttached = SrcConnectData%nAttached + DstConnectData%conM = SrcConnectData%conM + DstConnectData%conV = SrcConnectData%conV + DstConnectData%conFX = SrcConnectData%conFX + DstConnectData%conFY = SrcConnectData%conFY + DstConnectData%conFZ = SrcConnectData%conFZ + DstConnectData%conCa = SrcConnectData%conCa + DstConnectData%conCdA = SrcConnectData%conCdA + DstConnectData%time = SrcConnectData%time + DstConnectData%r = SrcConnectData%r + DstConnectData%rd = SrcConnectData%rd + DstConnectData%a = SrcConnectData%a + DstConnectData%U = SrcConnectData%U + DstConnectData%Ud = SrcConnectData%Ud + DstConnectData%zeta = SrcConnectData%zeta +IF (ALLOCATED(SrcConnectData%PDyn)) THEN + i1_l = LBOUND(SrcConnectData%PDyn,1) + i1_u = UBOUND(SrcConnectData%PDyn,1) + IF (.NOT. ALLOCATED(DstConnectData%PDyn)) THEN + ALLOCATE(DstConnectData%PDyn(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%r.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConnectData%PDyn.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%r = SrcLineData%r + DstConnectData%PDyn = SrcConnectData%PDyn 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 + DstConnectData%Fnet = SrcConnectData%Fnet + DstConnectData%M = SrcConnectData%M + END SUBROUTINE MD_CopyConnect + + SUBROUTINE MD_DestroyConnect( ConnectData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(MD_Connect), INTENT(INOUT) :: ConnectData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,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_DestroyConnect' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. END IF - DstLineData%rd = SrcLineData%rd + +IF (ALLOCATED(ConnectData%PDyn)) THEN + DEALLOCATE(ConnectData%PDyn) 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 SUBROUTINE MD_DestroyConnect + + SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, 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_Connect), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,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_PackConnect' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( 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 ! conM + Db_BufSz = Db_BufSz + 1 ! conV + Db_BufSz = Db_BufSz + 1 ! conFX + Db_BufSz = Db_BufSz + 1 ! conFY + Db_BufSz = Db_BufSz + 1 ! conFZ + Db_BufSz = Db_BufSz + 1 ! conCa + Db_BufSz = Db_BufSz + 1 ! conCdA + 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 - DstLineData%q = SrcLineData%q -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 + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', 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 + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', 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 + 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%conM + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conV + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conFX + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conFY + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conFZ + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conCa + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conCdA + 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 - 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 + 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_PackConnect + + SUBROUTINE MD_UnPackConnect( ReKiBuf, 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_Connect), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + 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_UnPackConnect' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + 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%conM = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conV = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conFX = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conFY = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conFZ = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conCa = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conCdA = 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 - DstLineData%lstrd = SrcLineData%lstrd + 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_UnPackConnect + + 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(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 (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 DstLineData%V.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%rd.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%V = SrcLineData%V + DstRodData%rd = SrcRodData%rd 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) + 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 DstLineData%T.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%l.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%T = SrcLineData%T + DstRodData%l = SrcRodData%l 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 (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 DstLineData%Td.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%Td = SrcLineData%Td + DstRodData%V = SrcRodData%V 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 (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 DstLineData%W.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%U.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%W = SrcLineData%W + DstRodData%U = SrcRodData%U 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 (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 DstLineData%Dp.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ud.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%Dp = SrcLineData%Dp + DstRodData%Ud = SrcRodData%Ud 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 (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 DstLineData%Dq.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%zeta.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%Dq = SrcLineData%Dq + DstRodData%zeta = SrcRodData%zeta 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 (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 DstLineData%Ap.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%PDyn.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%Ap = SrcLineData%Ap + DstRodData%PDyn = SrcRodData%PDyn 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 (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 DstLineData%Aq.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%W.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%Aq = SrcLineData%Aq + DstRodData%W = SrcRodData%W 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 (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 DstLineData%B.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Bo.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%B = SrcLineData%B + DstRodData%Bo = SrcRodData%Bo ENDIF -IF (ALLOCATED(SrcLineData%F)) THEN - i1_l = LBOUND(SrcLineData%F,1) - i1_u = UBOUND(SrcLineData%F,1) - i2_l = LBOUND(SrcLineData%F,2) - i2_u = UBOUND(SrcLineData%F,2) - IF (.NOT. ALLOCATED(DstLineData%F)) THEN - ALLOCATE(DstLineData%F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +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 DstLineData%F.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Pd.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%F = SrcLineData%F + DstRodData%Pd = SrcRodData%Pd 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 (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 DstLineData%S.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dp.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%S = SrcLineData%S + DstRodData%Dp = SrcRodData%Dp 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 (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 DstLineData%M.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dq.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%M = SrcLineData%M + DstRodData%Dq = SrcRodData%Dq ENDIF - 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 (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 DstLineData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ap.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%LineWrOutput = SrcLineData%LineWrOutput + DstRodData%Ap = SrcRodData%Ap ENDIF - END SUBROUTINE MD_CopyLine +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_DestroyLine( LineData, ErrStat, ErrMsg ) - TYPE(MD_Line), INTENT(INOUT) :: LineData + SUBROUTINE MD_DestroyRod( RodData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(MD_Rod), INTENT(INOUT) :: RodData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyLine' + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyRod' + + ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(LineData%r)) THEN - DEALLOCATE(LineData%r) -ENDIF -IF (ALLOCATED(LineData%rd)) THEN - DEALLOCATE(LineData%rd) + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(RodData%r)) THEN + DEALLOCATE(RodData%r) ENDIF -IF (ALLOCATED(LineData%q)) THEN - DEALLOCATE(LineData%q) +IF (ALLOCATED(RodData%rd)) THEN + DEALLOCATE(RodData%rd) ENDIF -IF (ALLOCATED(LineData%l)) THEN - DEALLOCATE(LineData%l) +IF (ALLOCATED(RodData%l)) THEN + DEALLOCATE(RodData%l) ENDIF -IF (ALLOCATED(LineData%ld)) THEN - DEALLOCATE(LineData%ld) +IF (ALLOCATED(RodData%V)) THEN + DEALLOCATE(RodData%V) ENDIF -IF (ALLOCATED(LineData%lstr)) THEN - DEALLOCATE(LineData%lstr) +IF (ALLOCATED(RodData%U)) THEN + DEALLOCATE(RodData%U) ENDIF -IF (ALLOCATED(LineData%lstrd)) THEN - DEALLOCATE(LineData%lstrd) +IF (ALLOCATED(RodData%Ud)) THEN + DEALLOCATE(RodData%Ud) ENDIF -IF (ALLOCATED(LineData%V)) THEN - DEALLOCATE(LineData%V) +IF (ALLOCATED(RodData%zeta)) THEN + DEALLOCATE(RodData%zeta) ENDIF -IF (ALLOCATED(LineData%T)) THEN - DEALLOCATE(LineData%T) +IF (ALLOCATED(RodData%PDyn)) THEN + DEALLOCATE(RodData%PDyn) ENDIF -IF (ALLOCATED(LineData%Td)) THEN - DEALLOCATE(LineData%Td) +IF (ALLOCATED(RodData%W)) THEN + DEALLOCATE(RodData%W) ENDIF -IF (ALLOCATED(LineData%W)) THEN - DEALLOCATE(LineData%W) +IF (ALLOCATED(RodData%Bo)) THEN + DEALLOCATE(RodData%Bo) ENDIF -IF (ALLOCATED(LineData%Dp)) THEN - DEALLOCATE(LineData%Dp) +IF (ALLOCATED(RodData%Pd)) THEN + DEALLOCATE(RodData%Pd) ENDIF -IF (ALLOCATED(LineData%Dq)) THEN - DEALLOCATE(LineData%Dq) +IF (ALLOCATED(RodData%Dp)) THEN + DEALLOCATE(RodData%Dp) ENDIF -IF (ALLOCATED(LineData%Ap)) THEN - DEALLOCATE(LineData%Ap) +IF (ALLOCATED(RodData%Dq)) THEN + DEALLOCATE(RodData%Dq) ENDIF -IF (ALLOCATED(LineData%Aq)) THEN - DEALLOCATE(LineData%Aq) +IF (ALLOCATED(RodData%Ap)) THEN + DEALLOCATE(RodData%Ap) ENDIF -IF (ALLOCATED(LineData%B)) THEN - DEALLOCATE(LineData%B) +IF (ALLOCATED(RodData%Aq)) THEN + DEALLOCATE(RodData%Aq) ENDIF -IF (ALLOCATED(LineData%F)) THEN - DEALLOCATE(LineData%F) +IF (ALLOCATED(RodData%B)) THEN + DEALLOCATE(RodData%B) ENDIF -IF (ALLOCATED(LineData%S)) THEN - DEALLOCATE(LineData%S) +IF (ALLOCATED(RodData%Fnet)) THEN + DEALLOCATE(RodData%Fnet) ENDIF -IF (ALLOCATED(LineData%M)) THEN - DEALLOCATE(LineData%M) +IF (ALLOCATED(RodData%M)) THEN + DEALLOCATE(RodData%M) ENDIF -IF (ALLOCATED(LineData%LineWrOutput)) THEN - DEALLOCATE(LineData%LineWrOutput) +IF (ALLOCATED(RodData%RodWrOutput)) THEN + DEALLOCATE(RodData%RodWrOutput) ENDIF - END SUBROUTINE MD_DestroyLine + END SUBROUTINE MD_DestroyRod - SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + 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_Line), INTENT(IN) :: InData + TYPE(MD_Rod), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -1427,7 +3190,7 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackLine' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackRod' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -1445,14 +3208,32 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = 0 Int_BufSz = Int_BufSz + 1 ! IdNum Int_BufSz = Int_BufSz + 1*LEN(InData%type) ! type - Int_BufSz = Int_BufSz + SIZE(InData%OutFlagList) ! OutFlagList - Int_BufSz = Int_BufSz + 1 ! CtrlChan - Int_BufSz = Int_BufSz + 1 ! FairConnect - Int_BufSz = Int_BufSz + 1 ! AnchConnect 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 ! BA + 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 @@ -1463,51 +3244,52 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz 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 ! 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 ! 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 ! 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 + 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 ! 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 + 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 @@ -1533,26 +3315,30 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz 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 ! F allocated yes/no - IF ( ALLOCATED(InData%F) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%F) ! F - 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 + 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 - 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 - Re_BufSz = Re_BufSz + SIZE(InData%LineWrOutput) ! LineWrOutput + 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 ) @@ -1587,23 +3373,67 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I - DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) - IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) + 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 - IntKiBuf(Int_Xferred) = InData%CtrlChan + 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%FairConnect + IntKiBuf(Int_Xferred) = InData%nAttachedB Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AnchConnect + 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%PropsIdNum + IntKiBuf(Int_Xferred) = InData%endTypeA Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%N + IntKiBuf(Int_Xferred) = InData%endTypeB Int_Xferred = Int_Xferred + 1 DbKiBuf(Db_Xferred) = InData%UnstrLen Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA + 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 @@ -1645,157 +3475,166 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%q) ) THEN + 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%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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%l,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) 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 + 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%l) ) THEN + 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%l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,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%l,1), UBOUND(InData%l,1) - DbKiBuf(Db_Xferred) = InData%l(i1) + 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%ld) ) THEN + 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%ld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ld,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 i1 = LBOUND(InData%ld,1), UBOUND(InData%ld,1) - DbKiBuf(Db_Xferred) = InData%ld(i1) - Db_Xferred = Db_Xferred + 1 + 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%lstr) ) THEN + 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%lstr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstr,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 i1 = LBOUND(InData%lstr,1), UBOUND(InData%lstr,1) - DbKiBuf(Db_Xferred) = InData%lstr(i1) - Db_Xferred = Db_Xferred + 1 + 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%lstrd) ) THEN + 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%lstrd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstrd,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%lstrd,1), UBOUND(InData%lstrd,1) - DbKiBuf(Db_Xferred) = InData%lstrd(i1) + 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%V) ) THEN + 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%V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,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%V,1), UBOUND(InData%V,1) - DbKiBuf(Db_Xferred) = InData%V(i1) + 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 + 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%T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,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%T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,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%T,2), UBOUND(InData%T,2) - DO i1 = LBOUND(InData%T,1), UBOUND(InData%T,1) - DbKiBuf(Db_Xferred) = InData%T(i1,i2) + 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%Td) ) THEN + 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%Td,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,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%Td,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,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%Td,2), UBOUND(InData%Td,2) - DO i1 = LBOUND(InData%Td,1), UBOUND(InData%Td,1) - DbKiBuf(Db_Xferred) = InData%Td(i1,i2) + 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%W) ) THEN + 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%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,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%W,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,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%W,2), UBOUND(InData%W,2) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - DbKiBuf(Db_Xferred) = InData%W(i1,i2) + 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 @@ -1900,51 +3739,26 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%F) ) THEN + 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%F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,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%F,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,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%F,2), UBOUND(InData%F,2) - DO i1 = LBOUND(InData%F,1), UBOUND(InData%F,1) - DbKiBuf(Db_Xferred) = InData%F(i1,i2) + 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 @@ -1970,30 +3784,70 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz END DO END DO END IF - IntKiBuf(Int_Xferred) = InData%LineUnOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LineWrOutput) ) THEN + 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%LineWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineWrOutput,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%LineWrOutput,1), UBOUND(InData%LineWrOutput,1) - ReKiBuf(Re_Xferred) = InData%LineWrOutput(i1) - Re_Xferred = Re_Xferred + 1 + 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_PackLine + END SUBROUTINE MD_PackRod - SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + 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_Line), INTENT(INOUT) :: OutData + TYPE(MD_Rod), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -2007,7 +3861,7 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) 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' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackRod' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -2024,25 +3878,77 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) 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%CtrlChan = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FairConnect = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AnchConnect = IntKiBuf(Int_Xferred) + OutData%N = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - OutData%PropsIdNum = IntKiBuf(Int_Xferred) + OutData%endTypeA = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - OutData%N = IntKiBuf(Int_Xferred) + OutData%endTypeB = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%UnstrLen = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - OutData%BA = DbKiBuf(Db_Xferred) + 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 @@ -2090,120 +3996,131 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q not allocated + 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 - 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 (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%q.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', 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 + 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 ! l not allocated + 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%l)) DEALLOCATE(OutData%l) - ALLOCATE(OutData%l(i1_l:i1_u),STAT=ErrStat2) + 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%l.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) - OutData%l(i1) = DbKiBuf(Db_Xferred) + 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 ! ld not allocated + 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%ld)) DEALLOCATE(OutData%ld) - ALLOCATE(OutData%ld(i1_l:i1_u),STAT=ErrStat2) + 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%ld.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', 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 + 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 ! lstr not allocated + 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 - IF (ALLOCATED(OutData%lstr)) DEALLOCATE(OutData%lstr) - ALLOCATE(OutData%lstr(i1_l:i1_u),STAT=ErrStat2) + 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%lstr.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', 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 + 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 ! lstrd not allocated + 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%lstrd)) DEALLOCATE(OutData%lstrd) - ALLOCATE(OutData%lstrd(i1_l:i1_u),STAT=ErrStat2) + 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%lstrd.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%lstrd,1), UBOUND(OutData%lstrd,1) - OutData%lstrd(i1) = DbKiBuf(Db_Xferred) + 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 ! V not allocated + 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%V)) DEALLOCATE(OutData%V) - ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) + 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%V.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = DbKiBuf(Db_Xferred) + 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 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -2213,20 +4130,20 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) 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 (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%T.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', 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) + 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 ! Td not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bo not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -2236,20 +4153,20 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) 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 (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%Td.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bo.', 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) + 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 ! W not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pd not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -2259,15 +4176,15 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) 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 (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%W.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', 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) + 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 @@ -2387,7 +4304,7 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fnet not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -2397,47 +4314,19 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) 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 (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%F.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', 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) = DbKiBuf(Db_Xferred) + 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 @@ -2466,776 +4355,632 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) END DO END DO END IF - OutData%LineUnOut = IntKiBuf(Int_Xferred) + 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 ! LineWrOutput not allocated + 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%LineWrOutput)) DEALLOCATE(OutData%LineWrOutput) - ALLOCATE(OutData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) + 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%LineWrOutput.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%LineWrOutput,1), UBOUND(OutData%LineWrOutput,1) - OutData%LineWrOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + 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_UnPackLine + END SUBROUTINE MD_UnPackRod - SUBROUTINE MD_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OutParmType), INTENT(IN) :: SrcOutParmTypeData - TYPE(MD_OutParmType), INTENT(INOUT) :: DstOutParmTypeData + 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_CopyOutParmType' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyLine' ! 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 ) - TYPE(MD_OutParmType), INTENT(INOUT) :: OutParmTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOutParmType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - 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 + DstLineData%IdNum = SrcLineData%IdNum + DstLineData%PropsIdNum = SrcLineData%PropsIdNum + DstLineData%ElasticMod = SrcLineData%ElasticMod + DstLineData%OutFlagList = SrcLineData%OutFlagList + DstLineData%CtrlChan = SrcLineData%CtrlChan + DstLineData%FairConnect = SrcLineData%FairConnect + DstLineData%AnchConnect = SrcLineData%AnchConnect + 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 - 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_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) + 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 DstInitOutputData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%rd.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr + DstLineData%rd = SrcLineData%rd 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 (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 DstInitOutputData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%q.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%writeOutputUnt = SrcInitOutputData%writeOutputUnt + DstLineData%q = SrcLineData%q 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 (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 DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%qs.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst + DstLineData%qs = SrcLineData%qs ENDIF - END SUBROUTINE MD_CopyInitOutput - - SUBROUTINE MD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(MD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%writeOutputHdr)) THEN - DEALLOCATE(InitOutputData%writeOutputHdr) +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(InitOutputData%writeOutputUnt)) THEN - DEALLOCATE(InitOutputData%writeOutputUnt) +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 - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) -IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN - DEALLOCATE(InitOutputData%CableCChanRqst) +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 - 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 +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 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 - 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 + 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 - 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 + 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 - 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 + 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 - 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) + 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 OutData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%PDyn.', 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) + 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 OutData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%T.', 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) + 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 OutData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Td.', 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 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) + 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 DstContStateData%states.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%W.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstContStateData%states = SrcContStateData%states -ENDIF - END SUBROUTINE MD_CopyContState - - 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' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ContStateData%states)) THEN - DEALLOCATE(ContStateData%states) + DstLineData%W = SrcLineData%W 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 +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 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 - 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 + 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 - 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) + 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 OutData%states.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Bs.', 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 + 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_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(MD_DiscreteStateType), INTENT(INOUT) :: DiscStateData + SUBROUTINE MD_DestroyLine( LineData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(MD_Line), INTENT(INOUT) :: LineData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyDiscState' + LOGICAL,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 = "" - END SUBROUTINE MD_DestroyDiscState - SUBROUTINE MD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + 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_DiscreteStateType), INTENT(IN) :: InData + TYPE(MD_Line), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -3250,7 +4995,7 @@ SUBROUTINE MD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackDiscState' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackLine' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -3266,17 +5011,191 @@ SUBROUTINE MD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 + 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 ! FairConnect + Int_BufSz = Int_BufSz + 1 ! AnchConnect + 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 - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN + 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 @@ -3294,449 +5213,6094 @@ SUBROUTINE MD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg 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 + 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%FairConnect + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AnchConnect + 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 - 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' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyConstrState + 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 - SUBROUTINE MD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + 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%FairConnect = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AnchConnect = 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_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%ConnectList)) THEN + i1_l = LBOUND(SrcMiscData%ConnectList,1) + i1_u = UBOUND(SrcMiscData%ConnectList,1) + IF (.NOT. ALLOCATED(DstMiscData%ConnectList)) THEN + ALLOCATE(DstMiscData%ConnectList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConnectList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%ConnectList,1), UBOUND(SrcMiscData%ConnectList,1) + CALL MD_Copyconnect( SrcMiscData%ConnectList(i1), DstMiscData%ConnectList(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%FreeConIs)) THEN + i1_l = LBOUND(SrcMiscData%FreeConIs,1) + i1_u = UBOUND(SrcMiscData%FreeConIs,1) + IF (.NOT. ALLOCATED(DstMiscData%FreeConIs)) THEN + ALLOCATE(DstMiscData%FreeConIs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeConIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%FreeConIs = SrcMiscData%FreeConIs +ENDIF +IF (ALLOCATED(SrcMiscData%CpldConIs)) THEN + i1_l = LBOUND(SrcMiscData%CpldConIs,1) + i1_u = UBOUND(SrcMiscData%CpldConIs,1) + i2_l = LBOUND(SrcMiscData%CpldConIs,2) + i2_u = UBOUND(SrcMiscData%CpldConIs,2) + IF (.NOT. ALLOCATED(DstMiscData%CpldConIs)) THEN + ALLOCATE(DstMiscData%CpldConIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldConIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%CpldConIs = SrcMiscData%CpldConIs +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%ConStateIs1)) THEN + i1_l = LBOUND(SrcMiscData%ConStateIs1,1) + i1_u = UBOUND(SrcMiscData%ConStateIs1,1) + IF (.NOT. ALLOCATED(DstMiscData%ConStateIs1)) THEN + ALLOCATE(DstMiscData%ConStateIs1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIs1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%ConStateIs1 = SrcMiscData%ConStateIs1 +ENDIF +IF (ALLOCATED(SrcMiscData%ConStateIsN)) THEN + i1_l = LBOUND(SrcMiscData%ConStateIsN,1) + i1_u = UBOUND(SrcMiscData%ConStateIsN,1) + IF (.NOT. ALLOCATED(DstMiscData%ConStateIsN)) THEN + ALLOCATE(DstMiscData%ConStateIsN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIsN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%ConStateIsN = SrcMiscData%ConStateIsN +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%ConnectList)) THEN +DO i1 = LBOUND(MiscData%ConnectList,1), UBOUND(MiscData%ConnectList,1) + CALL MD_Destroyconnect( MiscData%ConnectList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MiscData%ConnectList) +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%FreeConIs)) THEN + DEALLOCATE(MiscData%FreeConIs) +ENDIF +IF (ALLOCATED(MiscData%CpldConIs)) THEN + DEALLOCATE(MiscData%CpldConIs) +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%ConStateIs1)) THEN + DEALLOCATE(MiscData%ConStateIs1) +ENDIF +IF (ALLOCATED(MiscData%ConStateIsN)) THEN + DEALLOCATE(MiscData%ConStateIsN) +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_ConstraintStateType), INTENT(IN) :: InData + 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_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,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 ! ConnectList allocated yes/no + IF ( ALLOCATED(InData%ConnectList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ConnectList upper/lower bounds for each dimension + DO i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) + Int_BufSz = Int_BufSz + 3 ! ConnectList: size of buffers for each call to pack subtype + CALL MD_Packconnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ConnectList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ConnectList + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ConnectList + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ConnectList + 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 ! FreeConIs allocated yes/no + IF ( ALLOCATED(InData%FreeConIs) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FreeConIs upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%FreeConIs) ! FreeConIs + END IF + Int_BufSz = Int_BufSz + 1 ! CpldConIs allocated yes/no + IF ( ALLOCATED(InData%CpldConIs) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CpldConIs upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%CpldConIs) ! CpldConIs + 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 ! ConStateIs1 allocated yes/no + IF ( ALLOCATED(InData%ConStateIs1) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ConStateIs1 upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ConStateIs1) ! ConStateIs1 + END IF + Int_BufSz = Int_BufSz + 1 ! ConStateIsN allocated yes/no + IF ( ALLOCATED(InData%ConStateIsN) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ConStateIsN upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ConStateIsN) ! ConStateIsN + 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%ConnectList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ConnectList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConnectList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) + CALL MD_Packconnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, OnlySize ) ! ConnectList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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%FreeConIs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FreeConIs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeConIs,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FreeConIs,1), UBOUND(InData%FreeConIs,1) + IntKiBuf(Int_Xferred) = InData%FreeConIs(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CpldConIs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldConIs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldConIs,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldConIs,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldConIs,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%CpldConIs,2), UBOUND(InData%CpldConIs,2) + DO i1 = LBOUND(InData%CpldConIs,1), UBOUND(InData%CpldConIs,1) + IntKiBuf(Int_Xferred) = InData%CpldConIs(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%ConStateIs1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ConStateIs1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConStateIs1,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ConStateIs1,1), UBOUND(InData%ConStateIs1,1) + IntKiBuf(Int_Xferred) = InData%ConStateIs1(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ConStateIsN) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ConStateIsN,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConStateIsN,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ConStateIsN,1), UBOUND(InData%ConStateIsN,1) + IntKiBuf(Int_Xferred) = InData%ConStateIsN(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_BufSz INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + 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_PackConstrState' - ! buffers to store subtypes, if any + 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 - 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) + IF(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 ! ConnectList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ConnectList)) DEALLOCATE(OutData%ConnectList) + ALLOCATE(OutData%ConnectList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConnectList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ConnectList,1), UBOUND(OutData%ConnectList,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_Unpackconnect( Re_Buf, Db_Buf, Int_Buf, OutData%ConnectList(i1), ErrStat2, ErrMsg2 ) ! ConnectList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(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 ! FreeConIs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FreeConIs)) DEALLOCATE(OutData%FreeConIs) + ALLOCATE(OutData%FreeConIs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeConIs.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i1 = LBOUND(OutData%FreeConIs,1), UBOUND(OutData%FreeConIs,1) + OutData%FreeConIs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldConIs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CpldConIs)) DEALLOCATE(OutData%CpldConIs) + ALLOCATE(OutData%CpldConIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldConIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CpldConIs,2), UBOUND(OutData%CpldConIs,2) + DO i1 = LBOUND(OutData%CpldConIs,1), UBOUND(OutData%CpldConIs,1) + OutData%CpldConIs(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 ! ConStateIs1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ConStateIs1)) DEALLOCATE(OutData%ConStateIs1) + ALLOCATE(OutData%ConStateIs1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIs1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ConStateIs1,1), UBOUND(OutData%ConStateIs1,1) + OutData%ConStateIs1(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConStateIsN not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ConStateIsN)) DEALLOCATE(OutData%ConStateIsN) + ALLOCATE(OutData%ConStateIsN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIsN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ConStateIsN,1), UBOUND(OutData%ConStateIsN,1) + OutData%ConStateIsN(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 + 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 - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + 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 + 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(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 ) - TYPE(MD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOtherState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - 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) + 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 + 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 ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + 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 + 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 ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + 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 + 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 - 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 + END SUBROUTINE MD_UnPackMisc - SUBROUTINE MD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(MD_MiscVarType), INTENT(INOUT) :: DstMiscData + 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_CopyMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyParam' ! 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) + DstParamData%nLineTypes = SrcParamData%nLineTypes + DstParamData%nRodTypes = SrcParamData%nRodTypes + DstParamData%nConnects = SrcParamData%nConnects + DstParamData%nConnectsExtra = SrcParamData%nConnectsExtra + 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%nFreeCons = SrcParamData%nFreeCons +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 DstMiscData%LineTypeList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', 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 + DstParamData%nCpldBodies = SrcParamData%nCpldBodies ENDIF -IF (ALLOCATED(SrcMiscData%ConnectList)) THEN - i1_l = LBOUND(SrcMiscData%ConnectList,1) - i1_u = UBOUND(SrcMiscData%ConnectList,1) - IF (.NOT. ALLOCATED(DstMiscData%ConnectList)) THEN - ALLOCATE(DstMiscData%ConnectList(i1_l:i1_u),STAT=ErrStat2) +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 DstMiscData%ConnectList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcMiscData%ConnectList,1), UBOUND(SrcMiscData%ConnectList,1) - CALL MD_Copyconnect( SrcMiscData%ConnectList(i1), DstMiscData%ConnectList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstParamData%nCpldRods = SrcParamData%nCpldRods 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 (ALLOCATED(SrcParamData%nCpldCons)) THEN + i1_l = LBOUND(SrcParamData%nCpldCons,1) + i1_u = UBOUND(SrcParamData%nCpldCons,1) + IF (.NOT. ALLOCATED(DstParamData%nCpldCons)) THEN + ALLOCATE(DstParamData%nCpldCons(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldCons.', 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 ) + DstParamData%nCpldCons = SrcParamData%nCpldCons +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 -IF (ALLOCATED(SrcMiscData%FairIdList)) THEN - i1_l = LBOUND(SrcMiscData%FairIdList,1) - i1_u = UBOUND(SrcMiscData%FairIdList,1) - IF (.NOT. ALLOCATED(DstMiscData%FairIdList)) THEN - ALLOCATE(DstMiscData%FairIdList(i1_l:i1_u),STAT=ErrStat2) + 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 DstMiscData%FairIdList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%FairIdList = SrcMiscData%FairIdList + DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos ENDIF -IF (ALLOCATED(SrcMiscData%ConnIdList)) THEN - i1_l = LBOUND(SrcMiscData%ConnIdList,1) - i1_u = UBOUND(SrcMiscData%ConnIdList,1) - IF (.NOT. ALLOCATED(DstMiscData%ConnIdList)) THEN - ALLOCATE(DstMiscData%ConnIdList(i1_l:i1_u),STAT=ErrStat2) + 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 DstMiscData%ConnIdList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%ConnIdList = SrcMiscData%ConnIdList + DstParamData%pxWave = SrcParamData%pxWave ENDIF -IF (ALLOCATED(SrcMiscData%LineStateIndList)) THEN - i1_l = LBOUND(SrcMiscData%LineStateIndList,1) - i1_u = UBOUND(SrcMiscData%LineStateIndList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineStateIndList)) THEN - ALLOCATE(DstMiscData%LineStateIndList(i1_l:i1_u),STAT=ErrStat2) +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 DstMiscData%LineStateIndList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%LineStateIndList = SrcMiscData%LineStateIndList + DstParamData%pyWave = SrcParamData%pyWave ENDIF -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 (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 DstMiscData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput + DstParamData%pzWave = SrcParamData%pzWave ENDIF - END SUBROUTINE MD_CopyMisc + 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 + END SUBROUTINE MD_CopyParam - SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(MD_MiscVarType), INTENT(INOUT) :: MiscData + SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(MD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyMisc' + LOGICAL,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 (ALLOCATED(MiscData%LineTypeList)) THEN -DO i1 = LBOUND(MiscData%LineTypeList,1), UBOUND(MiscData%LineTypeList,1) - CALL MD_Destroylineprop( MiscData%LineTypeList(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%LineTypeList) + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(ParamData%nCpldBodies)) THEN + DEALLOCATE(ParamData%nCpldBodies) ENDIF -IF (ALLOCATED(MiscData%ConnectList)) THEN -DO i1 = LBOUND(MiscData%ConnectList,1), UBOUND(MiscData%ConnectList,1) - CALL MD_Destroyconnect( MiscData%ConnectList(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%ConnectList) +IF (ALLOCATED(ParamData%nCpldRods)) THEN + DEALLOCATE(ParamData%nCpldRods) ENDIF -IF (ALLOCATED(MiscData%LineList)) THEN -DO i1 = LBOUND(MiscData%LineList,1), UBOUND(MiscData%LineList,1) - CALL MD_Destroyline( MiscData%LineList(i1), ErrStat, ErrMsg ) +IF (ALLOCATED(ParamData%nCpldCons)) THEN + DEALLOCATE(ParamData%nCpldCons) +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(MiscData%LineList) + DEALLOCATE(ParamData%OutParam) ENDIF -IF (ALLOCATED(MiscData%FairIdList)) THEN - DEALLOCATE(MiscData%FairIdList) +IF (ALLOCATED(ParamData%TurbineRefPos)) THEN + DEALLOCATE(ParamData%TurbineRefPos) ENDIF -IF (ALLOCATED(MiscData%ConnIdList)) THEN - DEALLOCATE(MiscData%ConnIdList) +IF (ALLOCATED(ParamData%pxWave)) THEN + DEALLOCATE(ParamData%pxWave) ENDIF -IF (ALLOCATED(MiscData%LineStateIndList)) THEN - DEALLOCATE(MiscData%LineStateIndList) +IF (ALLOCATED(ParamData%pyWave)) THEN + DEALLOCATE(ParamData%pyWave) ENDIF -IF (ALLOCATED(MiscData%MDWrOutput)) THEN - DEALLOCATE(MiscData%MDWrOutput) +IF (ALLOCATED(ParamData%pzWave)) THEN + DEALLOCATE(ParamData%pzWave) ENDIF - END SUBROUTINE MD_DestroyMisc +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 + END SUBROUTINE MD_DestroyParam - SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + 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_MiscVarType), INTENT(IN) :: InData + TYPE(MD_ParameterType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -3748,114 +11312,204 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz INTEGER(IntKi) :: Int_BufSz INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i,i1,i2,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 ! ConnectList allocated yes/no - IF ( ALLOCATED(InData%ConnectList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ConnectList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) - Int_BufSz = Int_BufSz + 3 ! ConnectList: size of buffers for each call to pack subtype - CALL MD_Packconnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ConnectList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ConnectList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ConnectList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ConnectList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + 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 ! nConnects + Int_BufSz = Int_BufSz + 1 ! nConnectsExtra + 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 ! nFreeCons + 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 ! nCpldCons allocated yes/no + IF ( ALLOCATED(InData%nCpldCons) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nCpldCons upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%nCpldCons) ! nCpldCons 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 + 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 ! LineList + IF(ALLOCATED(Re_Buf)) THEN ! OutParam Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineList + IF(ALLOCATED(Db_Buf)) THEN ! OutParam Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineList + 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 ! FairIdList allocated yes/no - IF ( ALLOCATED(InData%FairIdList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FairIdList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FairIdList) ! FairIdList - END IF - Int_BufSz = Int_BufSz + 1 ! ConnIdList allocated yes/no - IF ( ALLOCATED(InData%ConnIdList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ConnIdList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ConnIdList) ! ConnIdList - END IF - Int_BufSz = Int_BufSz + 1 ! LineStateIndList allocated yes/no - IF ( ALLOCATED(InData%LineStateIndList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineStateIndList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LineStateIndList) ! LineStateIndList - END IF - 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 - Re_BufSz = Re_BufSz + SIZE(InData%MDWrOutput) ! MDWrOutput + 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 IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -3871,209 +11525,620 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz RETURN END IF END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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%nConnects + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nConnectsExtra + 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%nFreeCons + 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%nCpldCons) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nCpldCons,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldCons,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nCpldCons,1), UBOUND(InData%nCpldCons,1) + IntKiBuf(Int_Xferred) = InData%nCpldCons(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(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + 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 - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + 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 - IF ( .NOT. ALLOCATED(InData%LineTypeList) ) THEN + 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%LineTypeList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineTypeList,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 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 + 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 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_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 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%ConnectList) ) THEN + 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%ConnectList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConnectList,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 i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) - CALL MD_Packconnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, OnlySize ) ! ConnectList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + 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 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_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%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%LineList) ) THEN + 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%LineList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineList,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%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 + 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 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_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%uyCurrent,1), UBOUND(InData%uyCurrent,1) + ReKiBuf(Re_Xferred) = InData%uyCurrent(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IF ( .NOT. ALLOCATED(InData%FairIdList) ) THEN + 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%FairIdList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FairIdList,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 i1 = LBOUND(InData%FairIdList,1), UBOUND(InData%FairIdList,1) - IntKiBuf(Int_Xferred) = InData%FairIdList(i1) - Int_Xferred = Int_Xferred + 1 + 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%ConnIdList) ) THEN + 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%ConnIdList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConnIdList,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%ConnIdList,1), UBOUND(InData%ConnIdList,1) - IntKiBuf(Int_Xferred) = InData%ConnIdList(i1) - Int_Xferred = Int_Xferred + 1 + 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%LineStateIndList) ) THEN + 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%LineStateIndList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIndList,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%LineStateIndList,1), UBOUND(InData%LineStateIndList,1) - IntKiBuf(Int_Xferred) = InData%LineStateIndList(i1) - Int_Xferred = Int_Xferred + 1 + 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 - IF ( .NOT. ALLOCATED(InData%MDWrOutput) ) THEN + 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%MDWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MDWrOutput,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%MDWrOutput,1), UBOUND(InData%MDWrOutput,1) - ReKiBuf(Re_Xferred) = InData%MDWrOutput(i1) - Re_Xferred = Re_Xferred + 1 + 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 - END SUBROUTINE MD_PackMisc + END SUBROUTINE MD_PackParam - SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + 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_MiscVarType), INTENT(INOUT) :: OutData + TYPE(MD_ParameterType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -4083,9 +12148,12 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) 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_UnPackMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackParam' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -4096,20 +12164,126 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineTypeList not allocated + OutData%nLineTypes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nRodTypes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nConnects = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nConnectsExtra = 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%nFreeCons = 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 ! nCpldCons not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%nCpldCons)) DEALLOCATE(OutData%nCpldCons) + ALLOCATE(OutData%nCpldCons(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldCons.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%nCpldCons,1), UBOUND(OutData%nCpldCons,1) + OutData%nCpldCons(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%LineTypeList)) DEALLOCATE(OutData%LineTypeList) - ALLOCATE(OutData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) + 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%LineTypeList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%LineTypeList,1), UBOUND(OutData%LineTypeList,1) + 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 @@ -4143,7 +12317,7 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) 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 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 @@ -4152,564 +12326,519 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConnectList not allocated + 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 - IF (ALLOCATED(OutData%ConnectList)) DEALLOCATE(OutData%ConnectList) - ALLOCATE(OutData%ConnectList(i1_l:i1_u),STAT=ErrStat2) + 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%ConnectList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%ConnectList,1), UBOUND(OutData%ConnectList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_Unpackconnect( Re_Buf, Db_Buf, Int_Buf, OutData%ConnectList(i1), ErrStat2, ErrMsg2 ) ! ConnectList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineList not allocated + 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%LineList)) DEALLOCATE(OutData%LineList) - ALLOCATE(OutData%LineList(i1_l:i1_u),STAT=ErrStat2) + 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%LineList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxWave.', 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 + 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 ! FairIdList not allocated + 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 - IF (ALLOCATED(OutData%FairIdList)) DEALLOCATE(OutData%FairIdList) - ALLOCATE(OutData%FairIdList(i1_l:i1_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( 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%FairIdList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ayWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%FairIdList,1), UBOUND(OutData%FairIdList,1) - OutData%FairIdList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + 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 ! ConnIdList not allocated + 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 - IF (ALLOCATED(OutData%ConnIdList)) DEALLOCATE(OutData%ConnIdList) - ALLOCATE(OutData%ConnIdList(i1_l:i1_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( 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%ConnIdList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%azWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%ConnIdList,1), UBOUND(OutData%ConnIdList,1) - OutData%ConnIdList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + 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 ! LineStateIndList not allocated + 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%LineStateIndList)) DEALLOCATE(OutData%LineStateIndList) - ALLOCATE(OutData%LineStateIndList(i1_l:i1_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( 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%LineStateIndList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%LineStateIndList,1), UBOUND(OutData%LineStateIndList,1) - OutData%LineStateIndList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + 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 ! MDWrOutput not allocated + 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%MDWrOutput)) DEALLOCATE(OutData%MDWrOutput) - ALLOCATE(OutData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( 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%MDWrOutput.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%MDWrOutput,1), UBOUND(OutData%MDWrOutput,1) - OutData%MDWrOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + 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 - 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%NTypes = SrcParamData%NTypes - DstParamData%NConnects = SrcParamData%NConnects - DstParamData%NFairs = SrcParamData%NFairs - DstParamData%NConns = SrcParamData%NConns - DstParamData%NAnchs = SrcParamData%NAnchs - DstParamData%NLines = SrcParamData%NLines - 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%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 - END SUBROUTINE MD_CopyParam - - SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(MD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL MD_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%OutParam) -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 ! NTypes - Int_BufSz = Int_BufSz + 1 ! NConnects - Int_BufSz = Int_BufSz + 1 ! NFairs - Int_BufSz = Int_BufSz + 1 ! NConns - Int_BufSz = Int_BufSz + 1 ! NAnchs - Int_BufSz = Int_BufSz + 1 ! NLines - Re_BufSz = Re_BufSz + 1 ! g - Re_BufSz = Re_BufSz + 1 ! rhoW - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! kBot - Re_BufSz = Re_BufSz + 1 ! cBot - Re_BufSz = Re_BufSz + 1 ! dtM0 - Re_BufSz = Re_BufSz + 1 ! dtCoupling - 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 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 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END 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%NTypes + OutData%nzCurrent = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NConnects + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzCurrent not allocated Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NFairs + ELSE Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NConns + 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 - IntKiBuf(Int_Xferred) = InData%NAnchs + ELSE Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NLines + 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 - ReKiBuf(Re_Xferred) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhoW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kBot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%cBot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dtM0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dtCoupling - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts + ELSE 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 + 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 - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 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 + 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 - 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 - 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) :: 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%NTypes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NConnects = IntKiBuf(Int_Xferred) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 - OutData%NFairs = IntKiBuf(Int_Xferred) + ELSE Int_Xferred = Int_Xferred + 1 - OutData%NConns = IntKiBuf(Int_Xferred) + 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 - OutData%NAnchs = IntKiBuf(Int_Xferred) + ELSE Int_Xferred = Int_Xferred + 1 - OutData%NLines = IntKiBuf(Int_Xferred) + 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%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhoW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%kBot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%cBot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dtM0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dtCoupling = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) + OutData%Jac_nx = 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 + 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%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) + 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%OutParam.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxIdx_map2_xStateIdx.', 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 + 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 - 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 END SUBROUTINE MD_UnPackParam SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4727,9 +12856,22 @@ SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) ! ErrStat = ErrID_None ErrMsg = "" - CALL MeshCopy( SrcInputData%PtFairleadDisplacement, DstInputData%PtFairleadDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) +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) @@ -4756,16 +12898,34 @@ SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_CopyInput - SUBROUTINE MD_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE MD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInput' + LOGICAL,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 = "" - CALL MeshDestroy( InputData%PtFairleadDisplacement, ErrStat, 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 @@ -4809,24 +12969,30 @@ SUBROUTINE MD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si 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) - 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 + 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 ! PtFairleadDisplacement + IF(ALLOCATED(Re_Buf)) THEN ! CoupledKinematics Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairleadDisplacement + IF(ALLOCATED(Db_Buf)) THEN ! CoupledKinematics Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairleadDisplacement + 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 @@ -4864,7 +13030,18 @@ SUBROUTINE MD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - CALL MeshPack( InData%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadDisplacement + 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 @@ -4892,6 +13069,8 @@ SUBROUTINE MD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si 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 @@ -4951,6 +13130,20 @@ SUBROUTINE MD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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 @@ -4984,13 +13177,15 @@ SUBROUTINE MD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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 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 @@ -5044,9 +13239,22 @@ SUBROUTINE MD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ! ErrStat = ErrID_None ErrMsg = "" - CALL MeshCopy( SrcOutputData%PtFairleadLoad, DstOutputData%PtFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) +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) @@ -5061,16 +13269,34 @@ SUBROUTINE MD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE MD_CopyOutput - SUBROUTINE MD_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE MD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOutput' + LOGICAL,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 = "" - CALL MeshDestroy( OutputData%PtFairleadLoad, ErrStat, 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 @@ -5111,24 +13337,30 @@ SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S 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) - 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 + 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 ! PtFairleadLoad + IF(ALLOCATED(Re_Buf)) THEN ! CoupledLoads Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairleadLoad + IF(ALLOCATED(Db_Buf)) THEN ! CoupledLoads Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairleadLoad + 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 @@ -5161,7 +13393,18 @@ SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadLoad + 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 @@ -5189,6 +13432,8 @@ SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S 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 @@ -5233,6 +13478,20 @@ SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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 @@ -5266,13 +13525,15 @@ SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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 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 @@ -5388,8 +13649,12 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) END IF ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) +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)) @@ -5459,8 +13724,12 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM END IF ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) +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 @@ -5572,8 +13841,12 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg END IF ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) +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)) @@ -5637,8 +13910,12 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END IF ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) +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 diff --git a/modules/moordyn/src/MoorDyn_bathymetry.txt b/modules/moordyn/src/MoorDyn_bathymetry.txt new file mode 100644 index 0000000000..bfe4ffbbbd --- /dev/null +++ b/modules/moordyn/src/MoorDyn_bathymetry.txt @@ -0,0 +1,8 @@ +--- 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/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index 6a56316bca..df2723a60b 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -36,15 +36,15 @@ MODULE ModMesh_Mapping !bjj: these types require the use of ModMesh.f90, thus they cannot be part of NWTC_Library_Types.f90 (though they are auto_generated with that code): - !> Type that describes characteristics of the mapping between two meshes + !> Type that describes characteristics of the mapping between two meshes TYPE, PUBLIC :: MapType - INTEGER(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 - REAL(R8Ki) :: distance !< magnitude of couple_arm - REAL(R8Ki) :: couple_arm(3) !< Vector between a point and node 1 of an element (p_ODR - p_OSR) - REAL(R8Ki) :: shape_fn(2) !< shape functions: 1-D element-level location [0,1] based on closest-line projection of point + INTEGER(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 [-] + REAL(R8Ki) :: distance !< magnitude of couple_arm [m] + REAL(R8Ki) :: couple_arm(3) !< Vector between a point and node 1 of an element (p_ODR - p_OSR) [m] + REAL(R8Ki) :: shape_fn(2) !< shape functions: 1-D element-level location [0,1] based on closest-line projection of point [-] END TYPE MapType - !> data structures (for linearization) containing jacobians of mapping between fields on different meshes + !> data structures (for linearization) containing jacobians of mapping between fields on different meshes TYPE, PUBLIC :: MeshMapLinearizationType ! values for motions: REAL(R8Ki), ALLOCATABLE :: mi(:,:) !< block matrix of motions that reflects identity (i.e., solely the mapping of one quantity to itself on another mesh) [-] @@ -62,21 +62,21 @@ MODULE ModMesh_Mapping END TYPE MeshMapLinearizationType - !> data structures to determine full mapping between fields on different meshes + !> data structures to determine full mapping between fields on different meshes TYPE, PUBLIC :: MeshMapType - TYPE(MapType), ALLOCATABLE :: MapLoads(:) !< mapping data structure for loads on the mesh + TYPE(MapType), ALLOCATABLE :: MapLoads(:) !< mapping data structure for loads on the mesh [-] TYPE(MapType), ALLOCATABLE :: MapMotions(:) !< mapping data structure for motions and/or scalars on the mesh [-] - TYPE(MapType), ALLOCATABLE :: MapSrcToAugmt(:) !< for source line2 loads, we map between source and an augmented source mesh, then between augmented source and destination - TYPE(MeshType) :: Augmented_Ln2_Src !< the augmented source mesh needed for some mapping types - TYPE(MeshType) :: Lumped_Points_Src !< a lumped mesh needed for some mapping types, stored here for efficiency + TYPE(MapType), ALLOCATABLE :: MapSrcToAugmt(:) !< for source line2 loads, we map between source and an augmented source mesh, then between augmented source and destination [-] + TYPE(MeshType) :: Augmented_Ln2_Src !< the augmented source mesh needed for some mapping types [-] + TYPE(MeshType) :: Lumped_Points_Src !< a lumped mesh needed for some mapping types, stored here for efficiency [-] #ifdef MESH_DEBUG TYPE(MeshType) :: Lumped_Points_Dest #endif - INTEGER, ALLOCATABLE :: LoadLn2_A_Mat_Piv(:) !< The pivot values for the factorization of LoadLn2_A_Mat - REAL(R8Ki), ALLOCATABLE :: DisplacedPosition(:,:,:) !< couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency) - REAL(R8Ki), ALLOCATABLE :: LoadLn2_A_Mat(:,:) !< The n-by-n (n=3xNNodes) matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping - REAL(R8Ki), ALLOCATABLE :: LoadLn2_F(:,:) !< The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element) - REAL(R8Ki), ALLOCATABLE :: LoadLn2_M(:,:) !< The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element) + INTEGER, ALLOCATABLE :: LoadLn2_A_Mat_Piv(:) !< The pivot values for the factorization of LoadLn2_A_Mat [-] + REAL(R8Ki), ALLOCATABLE :: DisplacedPosition(:,:,:) !< couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency) [m] + REAL(R8Ki), ALLOCATABLE :: LoadLn2_A_Mat(:,:) !< The n-by-n (n=3xNNodes) matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping [-] + REAL(R8Ki), ALLOCATABLE :: LoadLn2_F(:,:) !< The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element) [-] + REAL(R8Ki), ALLOCATABLE :: LoadLn2_M(:,:) !< The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element) [-] TYPE(MeshMapLinearizationType) :: dM !< type that contains information for linearization matrices, partial M partial u (or y) END TYPE MeshMapType @@ -2482,7 +2482,7 @@ SUBROUTINE Transfer_Point_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg, SrcDisp !! IF Src is forces and/or moments, loop over Src Mesh; !! each load in the source mesh needs to be placed somewhere in the destination mesh. - if ( HasLoadFields(Src) ) then + if ( HasLoadFields(Src) .AND. HasLoadFields(Dest) ) then !........................ ! Create mapping @@ -5763,10 +5763,10 @@ 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 +! WARNING This file is generated automatically by the FAST registry. ! Do not edit. Your changes to this file will be lost. ! -! FAST Registry (v3.02.00, 23-Jul-2016) +! FAST Registry !********************************************************************************************************************************* SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(MapType), INTENT(IN) :: SrcMapTypeData @@ -5791,15 +5791,27 @@ SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, CtrlCode, E DstMapTypeData%shape_fn = SrcMapTypeData%shape_fn END SUBROUTINE NWTC_Library_CopyMapType - SUBROUTINE NWTC_Library_DestroyMapType( MapTypeData, ErrStat, ErrMsg ) + SUBROUTINE NWTC_Library_DestroyMapType( MapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MapType), INTENT(INOUT) :: MapTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMapType' + LOGICAL,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 ) @@ -6101,15 +6113,27 @@ SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType( SrcMeshMapLinearizationTyp ENDIF END SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType - SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTypeData, ErrStat, ErrMsg ) + SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MeshMapLinearizationType), INTENT(INOUT) :: MeshMapLinearizationTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMeshMapLinearizationType' + LOGICAL,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 @@ -6913,35 +6937,52 @@ SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE NWTC_Library_CopyMeshMapType - SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg ) + SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MeshMapType), INTENT(INOUT) :: MeshMapTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMeshMapType' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL MeshDestroy( MeshMapTypeData%Lumped_Points_Src, ErrStat, ErrMsg ) + 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 @@ -6957,7 +6998,8 @@ SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg ) IF (ALLOCATED(MeshMapTypeData%LoadLn2_M)) THEN DEALLOCATE(MeshMapTypeData%LoadLn2_M) ENDIF - CALL NWTC_Library_Destroymeshmaplinearizationtype( MeshMapTypeData%dM, ErrStat, ErrMsg ) + 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 ) diff --git a/modules/nwtc-library/src/NWTC_Base.f90 b/modules/nwtc-library/src/NWTC_Base.f90 index 6690f0842c..acfa1ac357 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -36,6 +36,8 @@ MODULE NWTC_Base INTEGER, PARAMETER :: ErrMsgLen = 1024 !< The maximum number of characters in an error message in the FAST framework INTEGER(IntKi), PARAMETER :: ChanLen = 20 !< The maximum allowable length of channel names (i.e., width of output columns) in the FAST framework + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 !< The maximum allowable length of channel names without optional "-" or "M" at the beginning to indicate the negative of the channel + INTEGER(IntKi), PARAMETER :: MinChanLen = 10 !< The min allowable length of channel names (i.e., width of output columns), used because some modules (like Bladed DLL outputs) have excessively long names INTEGER(IntKi), PARAMETER :: LinChanLen = 200 !< The allowable length of row/column names in linearization files INTEGER(IntKi), PARAMETER :: MaxFileInfoLineLen = 1024 !< The allowable length of an input line stored in FileInfoType%Lines diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index 7be142eecb..cfd731dddd 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -2440,21 +2440,21 @@ END SUBROUTINE GetTokens !! It uses spaces, tabs, commas, semicolons, single quotes, and double quotes ("whitespace") !! as word separators. If there aren't NumWords in the line, the remaining array elements will remain empty. !! Use CountWords (nwtc_io::countwords) to count the number of words in a line. - SUBROUTINE GetWords ( Line, Words, NumWords ) + SUBROUTINE GetWords ( Line, Words, NumWords, NumFound ) ! Argument declarations. - INTEGER, INTENT(IN) :: NumWords !< The number of words to look for. - - CHARACTER(*), INTENT(IN) :: Line !< The string to search. - CHARACTER(*), INTENT(OUT) :: Words(NumWords) !< The array of found words. + INTEGER, INTENT(IN) :: NumWords !< The maximum number of words to look for (and size of Words) + CHARACTER(*), INTENT(IN) :: Line !< The string to search. + CHARACTER(*), INTENT(OUT) :: Words(NumWords) !< The array of found words. + INTEGER, OPTIONAL, INTENT(OUT) :: NumFound !< The number of words found ! Local declarations. - INTEGER :: Ch ! Character position within the string. - INTEGER :: IW ! Word index. - INTEGER :: NextWhite ! The location of the next whitespace in the string. + INTEGER :: Ch ! Character position within the string. + INTEGER :: IW ! Word index. + INTEGER :: NextWhite ! The location of the next whitespace in the string. @@ -2464,48 +2464,51 @@ SUBROUTINE GetWords ( Line, Words, NumWords ) Words(IW) = ' ' END DO ! IW + IW = 0 + ! Let's make sure we have text on this line. - IF ( LEN_TRIM( Line ) == 0 ) RETURN + IF ( LEN_TRIM( Line ) > 0 ) THEN + ! Parse words separated by any combination of spaces, tabs, commas, + ! semicolons, single quotes, and double quotes ("whitespace"). - ! Parse words separated by any combination of spaces, tabs, commas, - ! semicolons, single quotes, and double quotes ("whitespace"). + Ch = 0 - Ch = 0 - IW = 0 - - DO + DO - NextWhite = SCAN( Line(Ch+1:) , ' ,;''"'//Tab ) + NextWhite = SCAN( Line(Ch+1:) , ' ,;''"'//Tab ) - IF ( NextWhite > 1 ) THEN + IF ( NextWhite > 1 ) THEN - IW = IW + 1 - Words(IW) = Line(Ch+1:Ch+NextWhite-1) - if (NextWhite > len(words(iw)) ) then - call ProgWarn('Error reading field from file. There are too many characters in the input file to store in the field. Value may be truncated.') - end if + IW = IW + 1 + Words(IW) = Line(Ch+1:Ch+NextWhite-1) + if (NextWhite > len(words(iw)) ) then + call ProgWarn('Error reading field from file. There are too many characters in the input file to store in the field. Value may be truncated.') + end if - IF ( IW == NumWords ) EXIT + IF ( IW == NumWords ) EXIT - Ch = Ch + NextWhite + Ch = Ch + NextWhite - ELSE IF ( NextWhite == 1 ) THEN + ELSE IF ( NextWhite == 1 ) THEN - Ch = Ch + 1 + Ch = Ch + 1 - CYCLE + CYCLE - ELSE + ELSE - EXIT + EXIT - END IF - - END DO + END IF + END DO + + END IF + + IF (PRESENT(NumFound)) NumFound = IW RETURN END SUBROUTINE GetWords @@ -3178,7 +3181,6 @@ SUBROUTINE ParseChAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg ! Local declarations. INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. - INTEGER(IntKi) :: i ! Error status local to this routine. CHARACTER(*), PARAMETER :: RoutineName = 'ParseChAry' @@ -3187,7 +3189,8 @@ SUBROUTINE ParseChAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short.' & + ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -3196,7 +3199,7 @@ SUBROUTINE ParseChAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg IF ( ErrStatLcl /= 0 ) THEN CALL SetErrStat ( ErrID_Fatal, 'A fatal error occurred when parsing data from "' & //TRIM( FileInfo%FileList(FileInfo%FileIndx(LineNum)) )//'".'//NewLine// & - ' >> The "'//TRIM( AryName )//'" array was not assigned valid REAL values on line #' & + ' >> The "'//TRIM( AryName )//'" array was not assigned valid CHARACTER values on line #' & //TRIM( Num2LStr( FileInfo%FileLine(LineNum) ) )//'.'//NewLine//' >> The text being parsed was :'//NewLine & //' "'//TRIM( FileInfo%Lines(LineNum) )//'"',ErrStat,ErrMsg,RoutineName ) RETURN @@ -3229,7 +3232,8 @@ SUBROUTINE ParseCom ( FileInfo, LineNum, Var, ErrStat, ErrMsg, UnEc ) IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The comment line was not assigned because the file is too short.' & + ' >> The comment line was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -3279,7 +3283,7 @@ SUBROUTINE ParseChVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. INTEGER(IntKi) :: NameIndx ! The index into the Words array that points to the variable name. - CHARACTER(200) :: Words (2) ! The two "words" parsed from the line. + CHARACTER(NWTC_SizeOfNumWord) :: Words (2) ! The two "words" parsed from the line. CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ParseChVar' @@ -3291,7 +3295,8 @@ SUBROUTINE ParseChVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short.' & + ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -3408,7 +3413,8 @@ SUBROUTINE ParseR8Ary ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short.' & + ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -3473,7 +3479,8 @@ SUBROUTINE ParseR8Var ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short.' & + ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -3588,7 +3595,8 @@ SUBROUTINE ParseQuAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short.' & + ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -3653,7 +3661,8 @@ SUBROUTINE ParseQuVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short.' & + ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -3677,6 +3686,7 @@ SUBROUTINE ParseQuVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE ENDIF CALL CheckRealVar( Var, ExpVarName, ErrStatLcl, ErrMsg2) CALL SetErrStat(ErrStatLcl, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat>= AbortErrLev) return IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) WRITE (UnEc,'(1X,A15," = ",A20)') Words @@ -3764,7 +3774,8 @@ SUBROUTINE ParseInAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short.' & + ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -3949,7 +3960,8 @@ SUBROUTINE ParseInVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short.' & + ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -4070,7 +4082,8 @@ SUBROUTINE ParseLoAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short.' & + ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -4133,7 +4146,8 @@ SUBROUTINE ParseLoVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short.' & + ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -4143,10 +4157,8 @@ SUBROUTINE ParseLoVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE CALL ChkParseData ( Words, ExpVarName, FileInfo%FileList(FileInfo%FileIndx(LineNum)) & , FileInfo%FileLine(LineNum), NameIndx, ErrStatLcl, ErrMsg2 ) - IF ( ErrStatLcl /= 0 ) THEN CALL SetErrStat ( ErrStatLcl, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - RETURN - ENDIF + IF (ErrStat >= AbortErrLev) RETURN READ (Words(3-NameIndx),*,IOSTAT=ErrStatLcl) Var @@ -4247,7 +4259,8 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short.' & + ' >> The "'//TRIM( AryName )//'" array was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -4309,7 +4322,8 @@ SUBROUTINE ParseSiVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE IF (LineNum > size(FileInfo%Lines) ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & - ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short.' & + ' >> The "'//TRIM( ExpVarName )//'" variable was not assigned because the file is too short. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & , ErrStat, ErrMsg, RoutineName ) RETURN END IF @@ -4332,7 +4346,9 @@ SUBROUTINE ParseSiVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE RETURN ENDIF - CALL CheckRealVar( Var, ExpVarName, ErrStat, ErrMsg) + CALL CheckRealVar( Var, ExpVarName, ErrStatLcl, ErrMsg2 ) + CALL SetErrStat( ErrStatLcl, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) WRITE (UnEc,'(1X,A15," = ",A20)') Words !bjj: not sure this is the best way to echo the number being read (in case of truncation, etc) @@ -4742,7 +4758,8 @@ SUBROUTINE ProcessComFile ( TopFileName, FileInfo, ErrStat, ErrMsg ) ENDIF IF ( AryInd /= FileInfo%NumLines ) THEN ! This would happen if there is a mis-match between ScanComFile and ReadComFile - CALL SetErrStat( ErrID_Fatal, "Error processing files: number of lines read does not match array size.", ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, "Error processing files: number of lines read ("//trim(num2lstr(AryInd))// & + ") does not match array size ("//trim(num2lstr(fileInfo%NumLines))//").", ErrStat, ErrMsg, RoutineName ) CALL Cleanup() RETURN END IF @@ -6243,7 +6260,7 @@ END SUBROUTINE ReadOutputList !! These values represent the names of output channels, and they are specified in the format !! required for OutList(:) in FAST input files. !! The end of this list is specified with the line beginning with the 3 characters "END". - SUBROUTINE ReadOutputListFromFileInfo ( FileInfo, LineNum, CharAry, AryLenRead, AryName, AryDescr, ErrStat, ErrMsg, UnEc ) + SUBROUTINE ReadOutputListFromFileInfo ( FileInfo, LineNum, CharAry, AryLenRead, ErrStat, ErrMsg, UnEc ) ! Argument declarations: @@ -6256,9 +6273,6 @@ SUBROUTINE ReadOutputListFromFileInfo ( FileInfo, LineNum, CharAry, AryLenRead, CHARACTER(*), INTENT(OUT) :: CharAry(:) !< Character array being read (calling routine dimensions it to max allowable size). - CHARACTER(*), INTENT(IN) :: AryDescr !< Text string describing the variable. - CHARACTER(*), INTENT(IN) :: AryName !< Text string containing the variable name. - ! Local declarations: diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 47550fd321..ebe2e74a6c 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -137,15 +137,27 @@ SUBROUTINE NWTC_Library_CopyProgDesc( SrcProgDescData, DstProgDescData, CtrlCode DstProgDescData%Date = SrcProgDescData%Date END SUBROUTINE NWTC_Library_CopyProgDesc - SUBROUTINE NWTC_Library_DestroyProgDesc( ProgDescData, ErrStat, ErrMsg ) + SUBROUTINE NWTC_Library_DestroyProgDesc( ProgDescData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ProgDesc), INTENT(INOUT) :: ProgDescData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyProgDesc' + LOGICAL,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 ) @@ -330,15 +342,27 @@ SUBROUTINE NWTC_Library_CopyFASTdataType( SrcFASTdataTypeData, DstFASTdataTypeDa ENDIF END SUBROUTINE NWTC_Library_CopyFASTdataType - SUBROUTINE NWTC_Library_DestroyFASTdataType( FASTdataTypeData, ErrStat, ErrMsg ) + SUBROUTINE NWTC_Library_DestroyFASTdataType( FASTdataTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FASTdataType), INTENT(INOUT) :: FASTdataTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyFASTdataType' + LOGICAL,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 @@ -629,15 +653,27 @@ SUBROUTINE NWTC_Library_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, DstOutParmTypeData%SignM = SrcOutParmTypeData%SignM END SUBROUTINE NWTC_Library_CopyOutParmType - SUBROUTINE NWTC_Library_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg ) + SUBROUTINE NWTC_Library_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(OutParmType), INTENT(INOUT) :: OutParmTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyOutParmType' + LOGICAL,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 ) @@ -827,15 +863,27 @@ SUBROUTINE NWTC_Library_CopyFileInfoType( SrcFileInfoTypeData, DstFileInfoTypeDa ENDIF END SUBROUTINE NWTC_Library_CopyFileInfoType - SUBROUTINE NWTC_Library_DestroyFileInfoType( FileInfoTypeData, ErrStat, ErrMsg ) + SUBROUTINE NWTC_Library_DestroyFileInfoType( FileInfoTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FileInfoType), INTENT(INOUT) :: FileInfoTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyFileInfoType' + LOGICAL,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 @@ -1132,15 +1180,27 @@ SUBROUTINE NWTC_Library_CopyQuaternion( SrcQuaternionData, DstQuaternionData, Ct DstQuaternionData%v = SrcQuaternionData%v END SUBROUTINE NWTC_Library_CopyQuaternion - SUBROUTINE NWTC_Library_DestroyQuaternion( QuaternionData, ErrStat, ErrMsg ) + SUBROUTINE NWTC_Library_DestroyQuaternion( QuaternionData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Quaternion), INTENT(INOUT) :: QuaternionData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyQuaternion' + LOGICAL,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 ) @@ -1284,15 +1344,27 @@ SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType( SrcNWTC_RandomNumbe 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 ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyNWTC_RandomNumber_ParameterType' + LOGICAL,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 diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index 8154109871..f4cbe1324c 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -2406,6 +2406,51 @@ SUBROUTINE Eye3D( A, ErrStat, ErrMsg ) END DO END SUBROUTINE Eye3D +!==================================================================================================== +INTEGER FUNCTION FindValidChannelIndx(OutListVal, ValidParamAry, SignM_out) RESULT( Indx ) + + CHARACTER(*), INTENT(IN) :: OutListVal + CHARACTER(OutStrLenM1), INTENT(IN) :: ValidParamAry(:) + INTEGER, OPTIONAL, INTENT(OUT) :: SignM_out + + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) + INTEGER :: SignM + LOGICAL :: CheckOutListAgain ! Flag used to determine if output parameter starting with "M" is valid (or the negative of another parameter) + + OutListTmp = OutListVal + + ! 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 + 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. + SignM = 1 + ELSE + 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 + SignM = -1 ! ex, "MTipDxc1" causes the sign of TipDxc1 to be switched. + OutListTmp = OutListTmp(2:) + + Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + END IF + + IF (PRESENT(SignM_out)) SignM_out = SignM + +END FUNCTION FindValidChannelIndx !======================================================================= !> This routine uses the Gauss-Jordan elimination method for the !! solution of a given set of simultaneous linear equations. diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt index 3207dde39c..40cdaee1b9 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt @@ -28,8 +28,8 @@ typedef NWTC_Library FileInfoType IntKi NumLines typedef ^ ^ IntKi NumFiles typedef ^ ^ IntKi FileLine {:} typedef ^ ^ IntKi FileIndx {:} -typedef ^ ^ CHARACTER(1024) FileList {:} -typedef ^ ^ CHARACTER(1024) Lines {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} typedef NWTC_Library Quaternion ReKi q0 typedef ^ ^ ReKi v {3} diff --git a/modules/nwtc-library/src/SysGnuLinux.f90 b/modules/nwtc-library/src/SysGnuLinux.f90 index 8f3eeb9bc4..02d8fbb68c 100644 --- a/modules/nwtc-library/src/SysGnuLinux.f90 +++ b/modules/nwtc-library/src/SysGnuLinux.f90 @@ -541,6 +541,9 @@ FUNCTION dlClose(handle) BIND(C,NAME="dlclose") END INTERFACE + ErrStat = ErrID_None + ErrMsg = '' + ! Close the library: IF( .NOT. C_ASSOCIATED(DLL%FileAddrX) ) RETURN diff --git a/modules/nwtc-library/src/SysGnuWin.f90 b/modules/nwtc-library/src/SysGnuWin.f90 index f761a2e723..30ee9473e6 100644 --- a/modules/nwtc-library/src/SysGnuWin.f90 +++ b/modules/nwtc-library/src/SysGnuWin.f90 @@ -517,6 +517,9 @@ FUNCTION FreeLibrary(hLibModule) BIND(C, NAME='FreeLibrary') END INTERFACE + ErrStat = ErrID_None + ErrMsg = '' + ! Free the DLL: IF ( DLL%FileAddr == INT(0,C_INTPTR_T) ) RETURN diff --git a/modules/nwtc-library/src/SysIFL.f90 b/modules/nwtc-library/src/SysIFL.f90 index a3746afde3..4752deb39e 100644 --- a/modules/nwtc-library/src/SysIFL.f90 +++ b/modules/nwtc-library/src/SysIFL.f90 @@ -518,6 +518,9 @@ FUNCTION dlClose(handle) BIND(C,NAME="dlclose") END FUNCTION END INTERFACE + + ErrStat = ErrID_None + ErrMsg = '' ! Close the library: diff --git a/modules/nwtc-library/src/SysIVF.f90 b/modules/nwtc-library/src/SysIVF.f90 index 0e99442cdb..fe2745c6e3 100644 --- a/modules/nwtc-library/src/SysIVF.f90 +++ b/modules/nwtc-library/src/SysIVF.f90 @@ -452,7 +452,10 @@ SUBROUTINE FreeDynamicLib ( DLL, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None INTEGER(HANDLE) :: FileAddr ! The address of file FileName. (RETURN value from LoadLibrary in kernel32.f90) INTEGER(BOOL) :: Success ! Whether or not the call to FreeLibrary was successful - + + ErrStat = ErrID_None + ErrMsg = '' + IF ( DLL%FileAddr == INT(0,C_INTPTR_T) ) RETURN FileAddr = TRANSFER(DLL%FileAddr, FileAddr) !convert INTEGER(C_INTPTR_T) to INTEGER(HANDLE) [used only for compatibility with gfortran] diff --git a/modules/nwtc-library/src/SysMatlabLinuxGnu.f90 b/modules/nwtc-library/src/SysMatlabLinuxGnu.f90 index f948f6cd3e..faee037394 100644 --- a/modules/nwtc-library/src/SysMatlabLinuxGnu.f90 +++ b/modules/nwtc-library/src/SysMatlabLinuxGnu.f90 @@ -538,6 +538,9 @@ FUNCTION dlClose(handle) BIND(C,NAME="dlclose") END INTERFACE + ErrStat = ErrID_None + ErrMsg = '' + ! Close the library: IF( .NOT. C_ASSOCIATED(DLL%FileAddrX) ) RETURN diff --git a/modules/nwtc-library/src/SysMatlabLinuxIntel.f90 b/modules/nwtc-library/src/SysMatlabLinuxIntel.f90 index 6935a9ffaa..daa14592e5 100644 --- a/modules/nwtc-library/src/SysMatlabLinuxIntel.f90 +++ b/modules/nwtc-library/src/SysMatlabLinuxIntel.f90 @@ -529,6 +529,9 @@ FUNCTION dlClose(handle) BIND(C,NAME="dlclose") END INTERFACE + ErrStat = ErrID_None + ErrMsg = '' + ! Close the library: IF( .NOT. C_ASSOCIATED(DLL%FileAddrX) ) RETURN diff --git a/modules/nwtc-library/src/SysMatlabWindows.f90 b/modules/nwtc-library/src/SysMatlabWindows.f90 index 004a72ef30..100306a8ff 100644 --- a/modules/nwtc-library/src/SysMatlabWindows.f90 +++ b/modules/nwtc-library/src/SysMatlabWindows.f90 @@ -504,6 +504,9 @@ SUBROUTINE FreeDynamicLib ( DLL, ErrStat, ErrMsg ) INTEGER(HANDLE) :: FileAddr ! The address of file FileName. (RETURN value from LoadLibrary in kernel32.f90) INTEGER(BOOL) :: Success ! Whether or not the call to FreeLibrary was successful + ErrStat = ErrID_None + ErrMsg = '' + IF ( DLL%FileAddr == INT(0,C_INTPTR_T) ) RETURN FileAddr = TRANSFER(DLL%FileAddr, FileAddr) !convert INTEGER(C_INTPTR_T) to INTEGER(HANDLE) [used only for compatibility with gfortran] diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 1a54ec8ab4..b838662c2d 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -53,15 +53,17 @@ add_library(openfast_postlib ) target_link_libraries(openfast_postlib openfast_prelib scdataexlib foamfastlib versioninfolib) -add_library(openfastlib src/FAST_Library.f90) +add_library(openfastlib SHARED src/FAST_Library.f90) target_link_libraries(openfastlib openfast_postlib openfast_prelib scdataexlib foamfastlib) +set_property(TARGET openfastlib PROPERTY LINKER_LANGUAGE Fortran) string(TOUPPER ${CMAKE_Fortran_COMPILER_ID} _compiler_id) string(TOUPPER ${CMAKE_BUILD_TYPE} _build_type) -if (${_compiler_id} STREQUAL "GNU" AND ${_build_type} STREQUAL "RELEASE") +if (${_compiler_id} STREQUAL "GNU" AND NOT ${VARIABLE_TRACKING}) # With variable tracking enabled, the compile step frequently aborts on large modules and - # restarts with this option off. Disabling in Release mode avoids this problem when compiling with - # full optimizations, but leaves it enabled for RelWithDebInfo which adds both -O2 and -g flags. + # restarts with this option off. Disabling avoids this problem when compiling with + # full optimizations. However, variable tracking should be enabled when actively debugging + # for better runtime debugging output. # https://gcc.gnu.org/onlinedocs/gcc/Debugging-Options.html set_source_files_properties( src/FAST_Subs.f90 src/FAST_Types.f90 src/FAST_Library.f90 diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index f57e97b053..bd2609acb1 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -83,7 +83,7 @@ subroutine FAST_DeallocateTurbines(ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_Deal ErrMsg_c = C_NULL_CHAR end subroutine !================================================================================================================================== -subroutine FAST_Sizes(iTurb, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, tmax_c, ErrStat_c, ErrMsg_c, ChannelNames_c, TMax, InitInpAry) BIND (C, NAME='FAST_Sizes') +subroutine FAST_Sizes(iTurb, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, dt_out_c, tmax_c, ErrStat_c, ErrMsg_c, ChannelNames_c, TMax, InitInpAry) BIND (C, NAME='FAST_Sizes') IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: FAST_Sizes @@ -94,6 +94,7 @@ subroutine FAST_Sizes(iTurb, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, tm 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) @@ -151,6 +152,7 @@ subroutine FAST_Sizes(iTurb, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, tm 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 tmax_c = Turbine(iTurb)%p_FAST%TMax ErrStat_c = ErrStat diff --git a/modules/openfast-library/src/FAST_Library.h b/modules/openfast-library/src/FAST_Library.h index 3c5f4cd65b..890ec9ed90 100644 --- a/modules/openfast-library/src/FAST_Library.h +++ b/modules/openfast-library/src/FAST_Library.h @@ -27,9 +27,9 @@ EXTERNAL_ROUTINE void FAST_HubPosition(int * iTurb, float * absolute_position, f EXTERNAL_ROUTINE void FAST_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, int * NumOuts, double * dt, int * n_t_global, int *ErrStat, char *ErrMsg); #ifdef __cplusplus -EXTERNAL_ROUTINE void FAST_Sizes(int * iTurb, const char *InputFileName, int *AbortErrLev, int * NumOuts, double * dt, double * tmax, int *ErrStat, char *ErrMsg, char *ChannelNames, double *TMax = NULL, double *InitInputAry = NULL); +EXTERNAL_ROUTINE void FAST_Sizes(int * iTurb, const char *InputFileName, int *AbortErrLev, int * NumOuts, double * dt, double * dt_out, double * tmax, int *ErrStat, char *ErrMsg, char *ChannelNames, double *TMax = NULL, double *InitInputAry = NULL); #else -EXTERNAL_ROUTINE void FAST_Sizes(int * iTurb, const char *InputFileName, int *AbortErrLev, int * NumOuts, double * dt, double * tmax, int *ErrStat, char *ErrMsg, char *ChannelNames, double *TMax, double *InitInputAry); +EXTERNAL_ROUTINE void FAST_Sizes(int * iTurb, const char *InputFileName, int *AbortErrLev, int * NumOuts, double * dt, double * dt_out, double * tmax, int *ErrStat, char *ErrMsg, char *ChannelNames, double *TMax, double *InitInputAry); #endif EXTERNAL_ROUTINE void FAST_Start(int * iTurb, int *NumInputs_c, int *NumOutputs_c, double *InputAry, double *OutputAry, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_Update(int * iTurb, int *NumInputs_c, int *NumOutputs_c, double *InputAry, double *OutputAry, bool *EndSimulationEarly, int *ErrStat, char *ErrMsg); @@ -58,6 +58,16 @@ EXTERNAL_ROUTINE void FAST_CreateCheckpoint(int * iTurb, const char *CheckpointR #define MAXInitINPUTS 53 #define NumFixedInputs 2 + 2 + MAXIMUM_BLADES + 1 + MAXIMUM_AFCTRL + MAXIMUM_CABLE_DELTAL + MAXIMUM_CABLE_DELTALDOT - +/* Fixed inputs list: + 1 Generator Torque (N-m) + 2 Electrical Power (W) + 3 Yaw pos (rad) + 4 Yaw rate (rad/s) + 5-7 Blade 1-3 pitch angle (rad) + 8 High speed shaft brake fraction (-) + 9-11 Blade 1-3 Airfoil control (-) + 12-31 Cable control channel 1-20 DeltaL (m) + 32-51 Cable control channel 1-20 DeltaLDot (m/s) +*/ #endif diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index 63b06f2344..4645376c0f 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -118,6 +118,9 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, NumBlNodes, ErrStat, if ( p_FAST%CompMooring == Module_MAP ) then p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_MAP + else if ( p_FAST%CompMooring == Module_MD ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_MD end if @@ -1107,6 +1110,63 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, end if ! if ( p_FAST%LinOutMod ) 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 ) + 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 ) + !..................... ! Linearization of glue code Input/Output solve: !..................... @@ -1667,7 +1727,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, !............ ! 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, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + 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 SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1703,12 +1763,20 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial u^{MAP}} \end{bmatrix} = \f$ (dUdu block row 7=SD) !............ IF (p_FAST%CompSub == MODULE_SD) THEN - call Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, SD%Input(1), SD%y, ED%y, HD, MAPp, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, SD%Input(1), SD%y, ED%y, HD, MAPp, MD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ELSE IF (p_FAST%CompSub == Module_ExtPtfm) THEN CALL WrScr('>>> FAST_LIN: Linear_ExtPtfm_InputSolve_du, TODO') ENDIF + !............ + ! \f$ \frac{\partial U_\Lambda^{MD}}{\partial u^{MD}} \end{bmatrix} = \f$ (dUdu block row 9=MD) <<<< + !............ + if (p_FAST%CompMooring == MODULE_MD) then + call Linear_MD_InputSolve_du( p_FAST, y_FAST, MD%Input(1), ED%y, SD%y, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + ! LIN-TODO: Update the doc lines below to include SrvD, HD, SD, and MAP !..................................... ! dUdy @@ -1758,7 +1826,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, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + 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 SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1801,7 +1869,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, !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, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + 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 SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ELSE IF (p_FAST%CompSub == Module_ExtPtfm) THEN write(*,*)'>>> FAST_LIN: Linear_ExtPtfm_InputSolve_dy, TODO' @@ -1815,6 +1883,14 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if + !............ + ! \f$ \frac{\partial U_\Lambda^{MD}}{\partial y^{ED}} \end{bmatrix} = \f$ + ! \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 SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if END SUBROUTINE Glue_Jacobians @@ -1882,7 +1958,7 @@ 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, MeshMapData, dUdu, ErrStat, ErrMsg ) +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 ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) @@ -1895,6 +1971,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SD data at t TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD 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 @@ -1910,6 +1987,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD 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 INTEGER(IntKi) :: MAP_Start ! starting index of dUdu (column) where MAP fairlead motion inputs are located + INTEGER(IntKi) :: MD_Start ! starting index of dUdu (column) where MD fairlead motion inputs are located INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -2164,6 +2242,29 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD call SetBlockMatrix( dUdu, MeshMapData%Mooring_P_2_ED_P%dM%m_us, ED_Start_mt, MAP_Start ) end if + !.......... + ! dU^{ED}/du^{MD} + !.......... + else if ( p_FAST%CompMooring == Module_MD ) then + + ED_Start_mt = Indx_u_ED_Platform_Start(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: + ! we're mapping loads, so we also need the sibling meshes' displacements: + + MD_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + ! 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 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 ) + end if + end if end if @@ -2172,7 +2273,7 @@ END SUBROUTINE Linear_ED_InputSolve_du !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{SD}/du^{SrvD}, dU^{SD}/du^{HD}, dU^{SD}/du^{SD}, and dU^{SD}/du^{MAP} blocks (SD row) of dUdu. (i.e., how do changes in SrvD, HD, SD, and MAP inputs affect the SD inputs?) -SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, MAPp, MeshMapData, dUdu, ErrStat, ErrMsg ) +SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, 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) @@ -2182,6 +2283,7 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, 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 + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD 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^(SD)/du^(AD) block INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status @@ -2190,7 +2292,7 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, ! local variables INTEGER(IntKi) :: j, SrvD_Start INTEGER(IntKi) :: HD_Start - INTEGER(IntKi) :: MAP_Start + INTEGER(IntKi) :: MAP_Start, MD_Start INTEGER(IntKi) :: SD_Start, SD_Start_td, SD_Start_tr INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -2309,31 +2411,52 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, ! dU^{SD}/du^{MAP} !.......... - if ( p_FAST%CompMooring == Module_MAP ) then + if ( p_FAST%CompMooring == Module_MAP ) then - ! Transfer MAP loads to ED PlatformPtmesh input: - ! we're mapping loads, so we also need the sibling meshes' displacements: + ! 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) - 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 + ! 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 + + !.......... + ! dU^{SD}/du^{MD} + !.......... + else if ( p_FAST%CompMooring == Module_MD ) then + + ! Transfer MD loads to ED PlatformPtmesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + + MD_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + ! 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 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 ) end if + + end if + END IF 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, MeshMapData, dUdy, ErrStat, ErrMsg ) +SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, 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) @@ -2343,14 +2466,15 @@ SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, 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 + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD 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^(SD)/dy^(SD) block INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables - INTEGER(IntKi) :: j, SrvD_Out_Start, SD_Start, SD_Out_Start, HD_Start, HD_Out_Start, ED_Out_Start, MAP_Out_Start - INTEGER(IntKi) :: MAP_Start + INTEGER(IntKi) :: j, SrvD_Out_Start, SD_Start, SD_Out_Start, HD_Start, HD_Out_Start, ED_Out_Start, MAP_Out_Start, MD_Out_Start + INTEGER(IntKi) :: MAP_Start, MD_Start ! INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation ! CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -2440,6 +2564,23 @@ SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, 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) + ! 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 ) + end if + + !.......... + ! dU^{SD}/dy^{MD} + !.......... + else if ( p_FAST%CompMooring == Module_MD ) then + if ( MD%y%CoupledLoads(1)%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. + 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) + ! 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 @@ -3001,7 +3142,7 @@ 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, MeshMapData, dUdy, ErrStat, ErrMsg ) +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 ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) @@ -3014,6 +3155,7 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SD data at t TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD 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 @@ -3032,6 +3174,7 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD INTEGER(IntKi) :: HD_Out_Start ! starting index of dUdy (column) where HD output fields are located INTEGER(IntKi) :: SD_Out_Start ! starting index of dUdy (column) where SD output fields are located INTEGER(IntKi) :: MAP_Out_Start ! starting index of dUdy (column) where MAP output fields are located + INTEGER(IntKi) :: MD_Out_Start ! starting index of dUdy (column) where MoorDyn output fields are located CHARACTER(*), PARAMETER :: RoutineName = 'Linear_ED_InputSolve_dy' @@ -3246,7 +3389,21 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD 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 ) end if - + ! MoorDyn + ! parts of dU^{ED}/dy^{MD} and dU^{ED}/dy^{ED}: + else if ( p_FAST%CompMooring == Module_MD ) then + if ( MD%y%CoupledLoads(1)%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. + 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 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 ) + end if end if else if ( p_FAST%CompSub == Module_SD ) then ! SubDyn @@ -3905,6 +4062,141 @@ SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, y_ED, y_SD, MeshMapD END IF 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(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) :: 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 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MD_InputSolve_du' + + + ErrStat = ErrID_None + ErrMsg = "" + IF (u_MD%CoupledKinematics(1)%Committed) THEN + !................................... + ! 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 ) + + ! 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 ) + 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 ) + 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 + +!---------------------------------------------------------------------------------------------------------------------------------- +!> 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 + 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(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) :: 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 + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MD_InputSolve_dy' + + + ErrStat = ErrID_None + ErrMsg = "" + IF (u_MD%CoupledKinematics(1)%Committed) THEN + !................................... + ! 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 ) + + 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.) + + end if + + END IF +END SUBROUTINE Linear_MD_InputSolve_dy + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine allocates the state matrices for the glue code and concatenates the module-level state matrices into @@ -4876,7 +5168,7 @@ 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 + 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 @@ -4886,7 +5178,7 @@ 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 + 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 @@ -4895,9 +5187,9 @@ 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 + 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 Y1Mesh data and get to the beginning of + 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 !---------------------------------------------------------------------------------------------------------------------------------- @@ -5283,6 +5575,7 @@ SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtf CALL MAP_CopyInput (MAPp%Input(1), y_FAST%op%u_MAP(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN CALL MD_CopyContState (MD%x( STATE_CURR), y_FAST%op%x_MD(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5295,6 +5588,7 @@ SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtf CALL MD_CopyInput (MD%Input(1), y_FAST%op%u_MD(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN CALL FEAM_CopyContState (FEAM%x( STATE_CURR), y_FAST%op%x_FEAM(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5474,8 +5768,8 @@ SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, do j=1,size(AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element,2) 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_dot) - 1 - call GetStateAry(p_FAST, iMode, t, AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element(i,j)%vind_dot, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( indx : indx_last), & + 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) ) indx = indx_last + 1 end do @@ -6155,8 +6449,25 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - !! MoorDyn - !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + ! 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 ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + 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 @@ -6332,8 +6643,17 @@ SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, CALL MAP_CopyOutput (MAPp%y, MAPp%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !! MoorDyn - !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + ! MoorDyn + ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL MD_CopyOutput (MD%Output(j), MD%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL MD_CopyOutput (MD%y, MD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + !! FEAM !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN !! OrcaFlex @@ -6494,8 +6814,16 @@ SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, S 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 + ! 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 diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index c806cef96f..e18fc48de7 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -118,6 +118,9 @@ typedef ^ FAST_ParameterType IntKi CompIce - - - "Compute ice loading (switch) { typedef ^ FAST_ParameterType IntKi MHK - - - "MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}" - typedef ^ FAST_ParameterType LOGICAL UseDWM - - - "Use the DWM module in AeroDyn" - typedef ^ FAST_ParameterType LOGICAL Linearize - - - "Linearization analysis (flag)" - +typedef ^ FAST_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 ^ FAST_ParameterType 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)" - +typedef ^ FAST_ParameterType SiKi TurbinePos {3} - - "Initial position of turbine base (origin used for graphics)" m # Environmental conditions: typedef ^ FAST_ParameterType ReKi Gravity - - - "Gravitational acceleration" m/s^2 typedef ^ FAST_ParameterType ReKi AirDens - - - "Air density" kg/m^3 @@ -166,7 +169,6 @@ typedef ^ FAST_ParameterType CHARACTER(1024) VTK_OutFileRoot - "''" - "The rootn typedef ^ FAST_ParameterType INTEGER VTK_tWidth - - - "Width of number of files for leading zeros in file name format" - typedef ^ FAST_ParameterType DbKi VTK_fps - - - "number of frames per second to output VTK data" - typedef ^ FAST_ParameterType FAST_VTK_SurfaceType VTK_surface - - - "Data for VTK surface visualization" -typedef ^ FAST_ParameterType SiKi TurbinePos {3} - - "Initial position of turbine base (origin used for graphics)" m typedef ^ FAST_ParameterType CHARACTER(4) Tdesc - - - "description of turbine ID (for FAST.Farm) screen printing" # Parameters for linearization @@ -558,6 +560,8 @@ typedef ^ ^ MD_ParameterType p - - - "Parameters" typedef ^ ^ MD_InputType u - - - "System inputs" typedef ^ ^ MD_OutputType y - - - "System outputs" 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 ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -640,6 +644,8 @@ typedef ^ FAST_ModuleMapType Integer Jac_u_indx {:}{:} - - "matrix to help fill/ 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 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" @@ -656,6 +662,7 @@ 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_FarmMD_CoupledLoads - - - "FAST-internal copy of MoorDyn's CoupledLoads output mesh for use with shared moorings in FAST.Farm" # ..... 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" @@ -723,7 +730,8 @@ 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 TurbineID - 0 - "ID number for turbine (used to create output file naming convention)" - -typedef ^ FAST_ExternInitType ReKi TurbinePos {3} - - "Initial position of turbine base (origin used in future for graphics)" m +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" - typedef ^ FAST_ExternInitType IntKi NumSC2CtrlGlob - - - "number of global controller inputs [from supercontroller]" - typedef ^ FAST_ExternInitType IntKi NumSC2Ctrl - - - "number of turbine specific controller inputs [from supercontroller]" - typedef ^ FAST_ExternInitType IntKi NumCtrl2SC - - - "number of controller outputs [to supercontroller]" - @@ -737,7 +745,6 @@ typedef ^ FAST_ExternInitType CHARACTER(1024) RootName - - - "Root name of FAST 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" - - # ..... FAST Turbine Data (one realization) ....................................................................................................... typedef ^ FAST_TurbineType IntKi TurbID - 1 - "Turbine ID Number" - typedef ^ FAST_TurbineType FAST_ParameterType p_FAST - - - "Parameters for the glue code" - diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 364d0b78cf..2e53cebc88 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -607,9 +607,10 @@ SUBROUTINE AD_InputSolve_IfW( p_FAST, u_AD, y_IfW, y_OpFM, ErrStat, ErrMsg ) end if 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) +! for cfd we will lump the hub and nacelle together + u_AD%rotors(1)%InflowOnNacelle(1) = y_OpFM%u(1) + u_AD%rotors(1)%InflowOnNacelle(2) = y_OpFM%v(1) + u_AD%rotors(1)%InflowOnNacelle(3) = y_OpFM%w(1) node = node + 1 else u_AD%rotors(1)%InflowOnNacelle = 0.0_ReKi @@ -1393,8 +1394,8 @@ SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! motions: - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_MD%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_MD%PtFairleadDisplacement' ) + CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_MD%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_MD%CoupledKinematics' ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! motions: @@ -2030,6 +2031,7 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) !.................. ! Set mooring line inputs (which don't have acceleration fields) !.................. + !TODO: MoorDyn input mesh now has acceleration fields, and they are used in some uncommon cases. Is this an issue? <<< IF ( p_FAST%CompMooring == Module_MAP ) THEN @@ -2043,10 +2045,10 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) 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%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) + 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 ) - CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations + 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 SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN @@ -2064,7 +2066,14 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) MeshMapData%u_ED_PlatformPtMesh%Moment = 0.0_ReKi END IF - + + + ! add farm-level mooring loads if applicable >>> note: not yet set up for SubDyn <<< + 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 + 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 @@ -2974,10 +2983,10 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! 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%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) + 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%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) + 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 @@ -3261,13 +3270,13 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_SD_LMesh_2, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, y_SD2%Y3Mesh ) !u_MD and y_SD contain the displacements needed for moment calculations + 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%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations + 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) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force @@ -3296,7 +3305,14 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, 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 - + + + ! 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 + 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 @@ -4229,8 +4245,8 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp MAPp%Input(1)%PtFairDisplacement%RemapFlag = .FALSE. MAPp%y%PtFairleadLoad%RemapFlag = .FALSE. ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - MD%Input(1)%PtFairleadDisplacement%RemapFlag = .FALSE. - MD%y%PtFairleadLoad%RemapFlag = .FALSE. + MD%Input(1)%CoupledKinematics(1)%RemapFlag = .FALSE. + MD%y%CoupledLoads(1)%RemapFlag = .FALSE. ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN FEAM%Input(1)%PtFairleadDisplacement%RemapFlag = .FALSE. FEAM%y%PtFairleadLoad%RemapFlag = .FALSE. @@ -4765,18 +4781,18 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! SubDyn <-> MoorDyn !------------------------- ! MoorDyn point mesh to/from SubDyn point mesh - CALL MeshMapCreate( MD%y%PtFairleadLoad, SD%Input(1)%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2 ) + 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)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + 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 !------------------------- ! ElastoDyn <-> MoorDyn !------------------------- ! MoorDyn point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( MD%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + 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)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + 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 @@ -4900,6 +4916,19 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M 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 ( ED%Input(1)%PlatformPtMesh, MeshMapData%u_ED_PlatformPtMesh_3, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh_3' ) + + ! 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' ) + + ! need to initialize to zero? + MeshMapData%u_ED_PlatformPtMesh_MDf%Force = 0.0_ReKi + MeshMapData%u_ED_PlatformPtMesh_MDf%Moment = 0.0_ReKi + end if + IF ( p_FAST%CompElast == Module_BD ) THEN @@ -5096,7 +5125,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca 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)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) + 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 ) @@ -5313,10 +5342,10 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, ! 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)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) + 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)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) + 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 diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 3a6fb654d4..0d4318ca7e 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -23,6 +23,7 @@ MODULE FAST_Subs USE FAST_Solver USE FAST_Linear + USE Waves, ONLY : WaveGrid_n USE SC_DataEx USE VersionInfo @@ -32,7 +33,7 @@ MODULE FAST_Subs !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! INITIALIZATION ROUTINES !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> a wrapper routine to call FAST_Initialize a the full-turbine simulation level (makes easier to write top-level driver) +!> a wrapper routine to call FAST_Initialize at the full-turbine simulation level (makes easier to write top-level driver) SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, InFile, ExternInitData ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time @@ -190,10 +191,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF ! ... Open and read input files ... - ! also, set turbine reference position for graphics output + ! 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%TurbinePos = ExternInitData%TurbinePos + p_FAST%WaveFieldMod = ExternInitData%WaveFieldMod if( (ExternInitData%NumSC2CtrlGlob .gt. 0) .or. (ExternInitData%NumSC2Ctrl .gt. 0) .or. (ExternInitData%NumCtrl2SC .gt. 0)) then p_FAST%UseSC = .TRUE. end if @@ -206,6 +209,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, else p_FAST%TurbinePos = 0.0_ReKi + p_FAST%WaveFieldMod = 0 CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2 ) ! We have the name of the input file from somewhere else (e.g. Simulink) end if @@ -741,7 +745,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%hasIce = p_FAST%CompIce /= Module_None Init%InData_HD%Linearize = p_FAST%Linearize - ! if wave field needs an offset, modify these values (added at request of SOWFA developers): + ! 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) @@ -946,14 +951,28 @@ 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 + CALL SetErrStat(ErrID_Fatal,"Error allocating MoorDyn PtfmInit and TurbineRefPos initialization inputs.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF Init%InData_MD%FileName = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. Init%InData_MD%RootName = p_FAST%OutFileRoot - Init%InData_MD%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_MD%g = p_FAST%Gravity ! This need to be according to g from driver - Init%InData_MD%rhoW = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn + 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%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%Tmax = p_FAST%TMax ! expected simulation duration (used by MoorDyn for wave kinematics preprocesing) + + Init%InData_MD%Linearize = p_FAST%Linearize + CALL MD_Init( Init%InData_MD, 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, p_FAST%dt_module( MODULE_MD ), Init%OutData_MD, ErrStat2, ErrMsg2 ) @@ -962,7 +981,22 @@ 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 ) + else + if (allocated(Init%OutData_MD%LinNames_y)) call move_alloc(Init%OutData_MD%LinNames_y,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_y) + if (allocated(Init%OutData_MD%LinNames_x)) call move_alloc(Init%OutData_MD%LinNames_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_x) + if (allocated(Init%OutData_MD%LinNames_u)) call move_alloc(Init%OutData_MD%LinNames_u,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_u) + if (allocated(Init%OutData_MD%RotFrame_y)) call move_alloc(Init%OutData_MD%RotFrame_y,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_y) + if (allocated(Init%OutData_MD%RotFrame_x)) call move_alloc(Init%OutData_MD%RotFrame_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_x) + if (allocated(Init%OutData_MD%RotFrame_u)) call move_alloc(Init%OutData_MD%RotFrame_u,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_u) + if (allocated(Init%OutData_MD%IsLoad_u )) call move_alloc(Init%OutData_MD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%IsLoad_u ) + 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 @@ -1913,7 +1947,7 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) 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%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_MAP) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the FEAMooring or MoorDyn mooring modules.',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 @@ -3308,6 +3342,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKParameters' + INTEGER(IntKi) :: rootNode, cylNode, tipNode ErrStat = ErrID_None @@ -3417,16 +3452,8 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H call move_alloc( InitOutData_AD%rotors(1)%BladeShape(k)%AirfoilCoords, p_FAST%VTK_Surface%BladeShape(k)%AirfoilCoords ) end do ELSE -#ifndef USE_DEFAULT_BLADE_SURFACE - call setErrStat(ErrID_Fatal,'Cannot do surface visualization without airfoil coordinates defined in AeroDyn.',ErrStat,ErrMsg,RoutineName) - return - END IF - ELSE - call setErrStat(ErrID_Fatal,'Cannot do surface visualization without using AeroDyn.',ErrStat,ErrMsg,RoutineName) - return - END IF -#else ! AD used without airfoil coordinates specified + call WrScr('Using generic blade surfaces for AeroDyn (S809 airfoil, assumed chord, twist, AC). ') rootNode = 1 @@ -3434,34 +3461,35 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H 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, ErrStat2, ErrMsg2) + 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 END DO END IF ELSE IF ( p_FAST%CompElast == Module_BD ) THEN + call WrScr('Using generic blade surfaces for BeamDyn (rectangular airfoil, constant chord). ') ! TODO make this an option rootNode = 1 DO K=1,NumBl tipNode = BD%y(k)%BldMotion%NNodes cylNode = min(3,BD%y(k)%BldMotion%NNodes) - call SetVTKDefaultBladeParams(BD%y(k)%BldMotion, p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, ErrStat2, ErrMsg2) + call SetVTKDefaultBladeParams(BD%y(k)%BldMotion, p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, 4, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN END DO ELSE + call WrScr('Using generic blade surfaces for ElastoDyn (rectangular airfoil, constant chord). ') ! TODO make this an option DO K=1,NumBl rootNode = ED%y%BladeLn2Mesh(K)%NNodes tipNode = ED%y%BladeLn2Mesh(K)%NNodes-1 cylNode = min(2,ED%y%BladeLn2Mesh(K)%NNodes) - call SetVTKDefaultBladeParams(ED%y%BladeLn2Mesh(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, ErrStat2, ErrMsg2) + call SetVTKDefaultBladeParams(ED%y%BladeLn2Mesh(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, 4, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN END DO END IF -#endif !....................... @@ -3498,13 +3526,14 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H END SUBROUTINE SetVTKParameters !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine comes up with some default airfoils for blade surfaces for a given blade mesh, M. -SUBROUTINE SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode, ErrStat, ErrMsg) +SUBROUTINE SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode, iShape, ErrStat, ErrMsg) TYPE(MeshType), INTENT(IN ) :: M !< The Mesh the defaults should be calculated for TYPE(FAST_VTK_BLSurfaceType), INTENT(INOUT) :: BladeShape !< BladeShape to set to default values INTEGER(IntKi), INTENT(IN ) :: rootNode !< Index of root node (innermost node) for this mesh INTEGER(IntKi), INTENT(IN ) :: tipNode !< Index of tip node (outermost node) for this mesh INTEGER(IntKi), INTENT(IN ) :: cylNode !< Index of last node to have a cylinder shape + INTEGER(IntKi), INTENT(IN ) :: iShape !< 1: S809, 2: circle, 3: square, 4: rectangle INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -3516,15 +3545,53 @@ SUBROUTINE SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode, E INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKDefaultBladeParams' + integer :: N ! Number of points for airfoil + real, allocatable, dimension(:) :: xc, yc ! Coordinate of airfoil - !Note: jmj does not like this default option + ErrStat = ErrID_None + ErrMsg = '' - integer, parameter :: N = 66 + select case (iShape) + case (1) + N=66 + call AllocAry(xc, N, 'xc', Errstat2, ErrMsg2) + call AllocAry(yc, N, 'yc', Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= AbortErrLev) return + xc=(/ 1.0,0.996203,0.98519,0.967844,0.945073,0.917488,0.885293,0.848455,0.80747,0.763042,0.715952,0.667064,0.617331,0.56783,0.519832,0.474243,0.428461,0.382612,0.33726,0.29297,0.250247,0.209576,0.171409,0.136174,0.104263,0.076035,0.051823,0.03191,0.01659,0.006026,0.000658,0.000204,0.0,0.000213,0.001045,0.001208,0.002398,0.009313,0.02323,0.04232,0.065877,0.093426,0.124111,0.157653,0.193738,0.231914,0.271438,0.311968,0.35337,0.395329,0.438273,0.48192,0.527928,0.576211,0.626092,0.676744,0.727211,0.776432,0.823285,0.86663,0.905365,0.938474,0.965086,0.984478,0.996141,1.0 /) + yc=(/ 0.0,0.000487,0.002373,0.00596,0.011024,0.017033,0.023458,0.03028,0.037766,0.045974,0.054872,0.064353,0.074214,0.084095,0.093268,0.099392,0.10176,0.10184,0.10007,0.096703,0.091908,0.085851,0.078687,0.07058,0.061697,0.052224,0.042352,0.032299,0.02229,0.012615,0.003723,0.001942,-0.00002,-0.001794,-0.003477,-0.003724,-0.005266,-0.011499,-0.020399,-0.030269,-0.040821,-0.051923,-0.063082,-0.07373,-0.083567,-0.092442,-0.099905,-0.105281,-0.108181,-0.108011,-0.104552,-0.097347,-0.086571,-0.073979,-0.060644,-0.047441,-0.0351,-0.024204,-0.015163,-0.008204,-0.003363,-0.000487,0.000743,0.000775,0.00029,0.0 /) + case (2) + ! Circle + N=21 + call AllocAry(xc, N, 'xc', Errstat2, ErrMsg2) + call AllocAry(yc, N, 'yc', Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= AbortErrLev) return + do i=1,N + angle = (i-1)*TwoPi/(N-1) + xc(i) = (cos(angle)+1)/2 ! between 0 and 1, 0.5 substracted later + yc(i) = (sin(angle)+1)/2-0.5 ! between -0.5 and 0.5 + enddo + case (3) + ! Square + N=5 + call AllocAry(xc, N, 'xc', Errstat2, ErrMsg2) + call AllocAry(yc, N, 'yc', Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= AbortErrLev) return + xc = (/1.0 , 0.0 , 0.0 , 1.0 , 1.0/) ! between 0 and 1, 0.5 substracted later + yc = (/-0.5 , -0.5 , 0.5 , 0.5 , -0.5/) ! between -0.5 and 0.5 + case (4) + ! Rectangle + N=5 + call AllocAry(xc, N, 'xc', Errstat2, ErrMsg2) + call AllocAry(yc, N, 'yc', Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= AbortErrLev) return + xc = (/1.0 , 0.0 , 0.0 , 1.0 , 1.0/) ! between 0 and 1, 0.5 substracted later + yc = (/-0.25 , -0.25 , 0.25 , 0.25 , 0.0/) ! between 0.25 and 0.25 + case default + call SetErrStat(ErrID_Fatal, 'Unknown iShape specfied for VTK default shapes',ErrStat,ErrMsg,RoutineName) + return + end select ! default airfoil shape coordinates; uses S809 values from http://wind.nrel.gov/airfoils/Shapes/S809_Shape.html: - real, parameter, dimension(N) :: xc=(/ 1.0,0.996203,0.98519,0.967844,0.945073,0.917488,0.885293,0.848455,0.80747,0.763042,0.715952,0.667064,0.617331,0.56783,0.519832,0.474243,0.428461,0.382612,0.33726,0.29297,0.250247,0.209576,0.171409,0.136174,0.104263,0.076035,0.051823,0.03191,0.01659,0.006026,0.000658,0.000204,0.0,0.000213,0.001045,0.001208,0.002398,0.009313,0.02323,0.04232,0.065877,0.093426,0.124111,0.157653,0.193738,0.231914,0.271438,0.311968,0.35337,0.395329,0.438273,0.48192,0.527928,0.576211,0.626092,0.676744,0.727211,0.776432,0.823285,0.86663,0.905365,0.938474,0.965086,0.984478,0.996141,1.0 /) - real, parameter, dimension(N) :: yc=(/ 0.0,0.000487,0.002373,0.00596,0.011024,0.017033,0.023458,0.03028,0.037766,0.045974,0.054872,0.064353,0.074214,0.084095,0.093268,0.099392,0.10176,0.10184,0.10007,0.096703,0.091908,0.085851,0.078687,0.07058,0.061697,0.052224,0.042352,0.032299,0.02229,0.012615,0.003723,0.001942,-0.00002,-0.001794,-0.003477,-0.003724,-0.005266,-0.011499,-0.020399,-0.030269,-0.040821,-0.051923,-0.063082,-0.07373,-0.083567,-0.092442,-0.099905,-0.105281,-0.108181,-0.108011,-0.104552,-0.097347,-0.086571,-0.073979,-0.060644,-0.047441,-0.0351,-0.024204,-0.015163,-0.008204,-0.003363,-0.000487,0.000743,0.000775,0.00029,0.0 /) - call AllocAry(BladeShape%AirfoilCoords, 2, N, M%NNodes, 'BladeShape%AirfoilCoords', ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3535,6 +3602,25 @@ SUBROUTINE SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode, E 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 + DO i=1,M%Nnodes + posLength = TwoNorm( M%Position(:,i) - M%Position(:,rootNode) ) + DO j=1,N + ! normalized x,y coordinates for airfoil + 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 + END DO + enddo + return ! We exit this routine + endif + + ! Assumed chord/twist/AC distribution for a blade DO i=1,M%Nnodes posLength = TwoNorm( M%Position(:,i) - M%Position(:,rootNode) ) @@ -5560,8 +5646,8 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN if (allocated(MD%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, MD%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MD%Input(1)%PtFairleadDisplacement ) - !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, MD%y%CoupledLoads(1), trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MD%Input(1)%CoupledKinematics(1) ) + !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if ! FEAMooring @@ -5695,7 +5781,7 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, ! 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, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! END IF @@ -5816,7 +5902,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW ! 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 ) ! ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, 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 ) ! ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! END IF @@ -7263,6 +7349,9 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreForVTKModeShape_T' CHARACTER(1024) :: VTK_RootName + CHARACTER(1024) :: VTK_RootDir + CHARACTER(1024) :: vtkroot + CHARACTER(1024) :: sInfo !< String used for formatted screen output ErrStat = ErrID_None @@ -7283,15 +7372,25 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, VTK_RootName = p_FAST%VTK_OutFileRoot - select case (p_FAST%VTK_modes%VTKLinTim) - case (1) - - do iMode = 1,p_FAST%VTK_modes%VTKLinModes - ModeNo = p_FAST%VTK_modes%VTKModes(iMode) - - call GetTimeConstants(p_FAST%VTK_modes%DampedFreq_Hz(ModeNo), p_FAST%VTK_fps, nt, dt, p_FAST%VTK_tWidth ) - if (nt > 500) cycle + ! Creating VTK folder in case user deleted it. + ! We have to extract the vtk root dir again because p_FAST%VTK_OutFileRoot contains the full basename + call GetPath ( p_FAST%OutFileRoot, VTK_RootDir, vtkroot ) + VTK_RootDir = trim(VTK_RootDir) // 'vtk' + call MKDIR( trim(VTK_RootDir) ) + + + do iMode = 1,p_FAST%VTK_modes%VTKLinModes + ModeNo = p_FAST%VTK_modes%VTKModes(iMode) + 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 + call WrScr(trim(sInfo)) + if (nt > 500) then + call WrScr(' Skipping mode '//trim(num2lstr(ModeNo))//' due to low frequency.') + cycle + endif + select case (p_FAST%VTK_modes%VTKLinTim) + case (1) p_FAST%VTK_OutFileRoot = trim(VTK_RootName)//'.Mode'//trim(num2lstr(ModeNo)) y_FAST%VTK_count = 1 ! we are skipping the reference meshes by starting at 1 do iLinTime = 1,NLinTimes @@ -7320,15 +7419,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, 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) end do ! iLinTime - end do ! iMode - - case (2) - - do iMode = 1,p_FAST%VTK_modes%VTKLinModes - ModeNo = p_FAST%VTK_modes%VTKModes(iMode) - - call GetTimeConstants(p_FAST%VTK_modes%DampedFreq_Hz(ModeNo), p_FAST%VTK_fps, nt, dt, p_FAST%VTK_tWidth ) - if (nt > 500) cycle + case (2) do iLinTime = 1,NLinTimes p_FAST%VTK_OutFileRoot = trim(VTK_RootName)//'.Mode'//trim(num2lstr(ModeNo))//'.LinTime'//trim(num2lstr(iLinTime)) @@ -7359,19 +7450,22 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, 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) - end do + end do ! it + end do ! iLinTime + + end select ! VTKLinTim=1 or 2 + + end do ! iMode - end do ! iLinTime - end do ! iMode - end select END SUBROUTINE FAST_RestoreForVTKModeShape_T !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetTimeConstants(DampedFreq_Hz, VTK_fps, nt, dt, VTK_tWidth ) +SUBROUTINE GetTimeConstants(DampedFreq_Hz, VTK_fps, VTKLinTim, nt, dt, VTK_tWidth) REAL(R8Ki), INTENT(IN ) :: DampedFreq_Hz REAL(DbKi), INTENT(IN ) :: VTK_fps + INTEGER(IntKi), INTENT(IN ) :: VTKLinTim INTEGER(IntKi), INTENT( OUT) :: nt !< number of steps REAL(DbKi), INTENT( OUT) :: dt !< time step INTEGER(IntKi), INTENT( OUT) :: VTK_tWidth @@ -7380,21 +7474,27 @@ SUBROUTINE GetTimeConstants(DampedFreq_Hz, VTK_fps, nt, dt, VTK_tWidth ) INTEGER(IntKi) :: NCycles INTEGER(IntKi), PARAMETER :: MinFrames = 5 - if (DampedFreq_Hz <= 0.0_DbKi) then + if (DampedFreq_Hz <= 1e-4_DbKi) then nt = huge(nt) dt = epsilon(dt) VTK_tWidth = 1 return end if - nt = 1 - NCycles = 0 - do while (nt return radial component, FALSE => return 'x' direction estimate [-] INTEGER(IntKi) :: TurbineID = 0 !< ID number for turbine (used to create output file naming convention) [-] - REAL(ReKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used in future for graphics) [m] + 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] [-] @@ -817,15 +824,27 @@ SUBROUTINE FAST_CopyVTK_BLSurfaceType( SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfac ENDIF END SUBROUTINE FAST_CopyVTK_BLSurfaceType - SUBROUTINE FAST_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_BLSurfaceType' + LOGICAL,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 @@ -1075,15 +1094,27 @@ SUBROUTINE FAST_CopyVTK_SurfaceType( SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeD ENDIF END SUBROUTINE FAST_CopyVTK_SurfaceType - SUBROUTINE FAST_DestroyVTK_SurfaceType( VTK_SurfaceTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_SurfaceType' + LOGICAL,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 @@ -1095,7 +1126,8 @@ SUBROUTINE FAST_DestroyVTK_SurfaceType( VTK_SurfaceTypeData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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 @@ -1640,15 +1672,27 @@ SUBROUTINE FAST_CopyVTK_ModeShapeType( SrcVTK_ModeShapeTypeData, DstVTK_ModeShap ENDIF END SUBROUTINE FAST_CopyVTK_ModeShapeType - SUBROUTINE FAST_DestroyVTK_ModeShapeType( VTK_ModeShapeTypeData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' + LOGICAL,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 @@ -2116,6 +2160,9 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg 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 @@ -2162,7 +2209,6 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg 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%TurbinePos = SrcParamData%TurbinePos DstParamData%Tdesc = SrcParamData%Tdesc DstParamData%CalcSteady = SrcParamData%CalcSteady DstParamData%TrimCase = SrcParamData%TrimCase @@ -2185,17 +2231,31 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder END SUBROUTINE FAST_CopyParam - SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyParam' + LOGICAL,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 = "" - CALL FAST_Destroyvtk_surfacetype( ParamData%VTK_surface, ErrStat, ErrMsg ) - CALL FAST_Destroyvtk_modeshapetype( ParamData%VTK_modes, ErrStat, 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 ) @@ -2259,6 +2319,9 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 @@ -2320,7 +2383,6 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos Int_BufSz = Int_BufSz + 1*LEN(InData%Tdesc) ! Tdesc Int_BufSz = Int_BufSz + 1 ! CalcSteady Int_BufSz = Int_BufSz + 1 ! TrimCase @@ -2442,6 +2504,14 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 @@ -2588,10 +2658,6 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) - ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) - Re_Xferred = Re_Xferred + 1 - END DO DO I = 1, LEN(InData%Tdesc) IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) Int_Xferred = Int_Xferred + 1 @@ -2755,6 +2821,16 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) @@ -2915,12 +2991,6 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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%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 DO I = 1, LEN(OutData%Tdesc) OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 @@ -4085,19 +4155,32 @@ SUBROUTINE FAST_CopyLinStateSave( SrcLinStateSaveData, DstLinStateSaveData, Ctrl ENDIF END SUBROUTINE FAST_CopyLinStateSave - SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_LinStateSave), INTENT(INOUT) :: LinStateSaveData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinStateSave' + LOGICAL,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), ErrStat, ErrMsg ) + 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) @@ -4105,7 +4188,8 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -4113,7 +4197,8 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -4121,7 +4206,8 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -4129,7 +4215,8 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -4137,7 +4224,8 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -4145,7 +4233,8 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -4153,7 +4242,8 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -4161,7 +4251,8 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -4169,332 +4260,387 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL MD_DestroyInput( LinStateSaveData%u_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_MD) ENDIF @@ -12766,15 +12912,27 @@ SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs END SUBROUTINE FAST_CopyLinType - SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_LinType), INTENT(INOUT) :: LinTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinType' + LOGICAL,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 @@ -14169,18 +14327,31 @@ SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ENDIF END SUBROUTINE FAST_CopyModLinType - SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_ModLinType), INTENT(INOUT) :: ModLinTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModLinType' + LOGICAL,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), ErrStat, ErrMsg ) + CALL FAST_Destroylintype( ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModLinTypeData%Instance) ENDIF @@ -14428,19 +14599,33 @@ SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCod DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed END SUBROUTINE FAST_CopyLinFileType - SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_LinFileType), INTENT(INOUT) :: LinFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinFileType' + LOGICAL,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), ErrStat, ErrMsg ) + CALL FAST_Destroymodlintype( LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL FAST_Destroylintype( LinFileTypeData%Glue, ErrStat, ErrMsg ) + 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 ) @@ -14829,15 +15014,27 @@ SUBROUTINE FAST_CopyMiscLinType( SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCod ENDIF END SUBROUTINE FAST_CopyMiscLinType - SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_MiscLinType), INTENT(INOUT) :: MiscLinTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMiscLinType' + LOGICAL,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 @@ -15318,15 +15515,27 @@ SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput END SUBROUTINE FAST_CopyOutputFileType - SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' + LOGICAL,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 @@ -15340,10 +15549,13 @@ SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) DEALLOCATE(OutputFileTypeData%ChannelUnits) ENDIF DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Destroyprogdesc( OutputFileTypeData%Module_Ver(i1), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL FAST_Destroylinstatesave( OutputFileTypeData%op, ErrStat, ErrMsg ) + 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 ) @@ -16176,19 +16388,32 @@ SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCod ENDIF END SUBROUTINE FAST_CopyIceDyn_Data - SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceDyn_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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) @@ -16196,7 +16421,8 @@ SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -16204,7 +16430,8 @@ SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -16212,39 +16439,45 @@ SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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) @@ -17769,19 +18002,32 @@ SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, Ctrl ENDIF END SUBROUTINE FAST_CopyBeamDyn_Data - SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyBeamDyn_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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) @@ -17789,7 +18035,8 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -17797,7 +18044,8 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -17805,53 +18053,61 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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) @@ -19492,41 +19748,64 @@ SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData ENDIF END SUBROUTINE FAST_CopyElastoDyn_Data - SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyElastoDyn_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL ED_DestroyInput( ElastoDyn_DataData%u, ErrStat, ErrMsg ) - CALL ED_DestroyOutput( ElastoDyn_DataData%y, ErrStat, ErrMsg ) - CALL ED_DestroyMisc( ElastoDyn_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL ED_DestroyInput( ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ElastoDyn_DataData%Input) ENDIF @@ -20800,41 +21079,64 @@ SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, C ENDIF END SUBROUTINE FAST_CopyServoDyn_Data - SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyServoDyn_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL SrvD_DestroyInput( ServoDyn_DataData%u, ErrStat, ErrMsg ) - CALL SrvD_DestroyOutput( ServoDyn_DataData%y, ErrStat, ErrMsg ) - CALL SrvD_DestroyMisc( ServoDyn_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL SrvD_DestroyInput( ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ServoDyn_DataData%Input) ENDIF @@ -22089,34 +22391,55 @@ SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData ENDIF END SUBROUTINE FAST_CopyAeroDyn14_Data - SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn14_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL AD14_DestroyInput( AeroDyn14_DataData%u, ErrStat, ErrMsg ) - CALL AD14_DestroyOutput( AeroDyn14_DataData%y, ErrStat, ErrMsg ) - CALL AD14_DestroyMisc( AeroDyn14_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL AD14_DestroyInput( AeroDyn14_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(AeroDyn14_DataData%Input) ENDIF @@ -23185,41 +23508,64 @@ SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, Ctrl ENDIF END SUBROUTINE FAST_CopyAeroDyn_Data - SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL AD_DestroyInput( AeroDyn_DataData%u, ErrStat, ErrMsg ) - CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat, ErrMsg ) - CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL AD_DestroyInput( AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(AeroDyn_DataData%Input) ENDIF @@ -24493,41 +24839,64 @@ SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataD ENDIF END SUBROUTINE FAST_CopyInflowWind_Data - SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat, ErrMsg ) - CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat, ErrMsg ) - CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InflowWind_DataData%Input) ENDIF @@ -25733,19 +26102,35 @@ SUBROUTINE FAST_CopyOpenFOAM_Data( SrcOpenFOAM_DataData, DstOpenFOAM_DataData, C IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyOpenFOAM_Data - SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOpenFOAM_Data' + LOGICAL,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 = "" - CALL OpFM_DestroyInput( OpenFOAM_DataData%u, ErrStat, ErrMsg ) - CALL OpFM_DestroyOutput( OpenFOAM_DataData%y, ErrStat, ErrMsg ) - CALL OpFM_DestroyParam( OpenFOAM_DataData%p, ErrStat, ErrMsg ) - CALL OpFM_DestroyMisc( OpenFOAM_DataData%m, ErrStat, 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 ) @@ -26206,18 +26591,33 @@ SUBROUTINE FAST_CopySCDataEx_Data( SrcSCDataEx_DataData, DstSCDataEx_DataData, C IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopySCDataEx_Data - SUBROUTINE FAST_DestroySCDataEx_Data( SCDataEx_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySCDataEx_Data' + LOGICAL,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 = "" - CALL SC_DX_DestroyInput( SCDataEx_DataData%u, ErrStat, ErrMsg ) - CALL SC_DX_DestroyOutput( SCDataEx_DataData%y, ErrStat, ErrMsg ) - CALL SC_DX_DestroyParam( SCDataEx_DataData%p, ErrStat, 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 ) @@ -26664,44 +27064,67 @@ SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCod ENDIF END SUBROUTINE FAST_CopySubDyn_Data - SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat, ErrMsg ) - CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat, ErrMsg ) - CALL SD_DestroyMisc( SubDyn_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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 @@ -27953,34 +28376,55 @@ SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, Ctrl ENDIF END SUBROUTINE FAST_CopyExtPtfm_Data - SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExtPtfm_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%u, ErrStat, ErrMsg ) - CALL ExtPtfm_DestroyOutput( ExtPtfm_DataData%y, ErrStat, ErrMsg ) - CALL ExtPtfm_DestroyMisc( ExtPtfm_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ExtPtfm_DataData%Input) ENDIF @@ -29049,41 +29493,64 @@ SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, C ENDIF END SUBROUTINE FAST_CopyHydroDyn_Data - SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyHydroDyn_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%u, ErrStat, ErrMsg ) - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y, ErrStat, ErrMsg ) - CALL HydroDyn_DestroyMisc( HydroDyn_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(HydroDyn_DataData%Input) ENDIF @@ -30338,34 +30805,55 @@ SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, Ctrl ENDIF END SUBROUTINE FAST_CopyIceFloe_Data - SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceFloe_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL IceFloe_DestroyInput( IceFloe_DataData%u, ErrStat, ErrMsg ) - CALL IceFloe_DestroyOutput( IceFloe_DataData%y, ErrStat, ErrMsg ) - CALL IceFloe_DestroyMisc( IceFloe_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL IceFloe_DestroyInput( IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(IceFloe_DataData%Input) ENDIF @@ -31432,39 +31920,62 @@ SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrSta ENDIF END SUBROUTINE FAST_CopyMAP_Data - SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMAP_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL MAP_DestroyParam( MAP_DataData%p, ErrStat, ErrMsg ) - CALL MAP_DestroyInput( MAP_DataData%u, ErrStat, ErrMsg ) - CALL MAP_DestroyOutput( MAP_DataData%y, ErrStat, ErrMsg ) - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt_old, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL MAP_DestroyInput( MAP_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MAP_DataData%Input) ENDIF @@ -32711,34 +33222,55 @@ SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataD ENDIF END SUBROUTINE FAST_CopyFEAMooring_Data - SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyFEAMooring_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL FEAM_DestroyInput( FEAMooring_DataData%u, ErrStat, ErrMsg ) - CALL FEAM_DestroyOutput( FEAMooring_DataData%y, ErrStat, ErrMsg ) - CALL FEAM_DestroyMisc( FEAMooring_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL FEAM_DestroyInput( FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(FEAMooring_DataData%Input) ENDIF @@ -33758,6 +34290,25 @@ SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, Ctrl 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) @@ -33788,34 +34339,64 @@ SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, Ctrl ENDIF END SUBROUTINE FAST_CopyMoorDyn_Data - SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMoorDyn_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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 - CALL MD_DestroyParam( MoorDyn_DataData%p, ErrStat, ErrMsg ) - CALL MD_DestroyInput( MoorDyn_DataData%u, ErrStat, ErrMsg ) - CALL MD_DestroyOutput( MoorDyn_DataData%y, ErrStat, ErrMsg ) - CALL MD_DestroyMisc( MoorDyn_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL MD_DestroyInput( MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MoorDyn_DataData%Input) ENDIF @@ -34004,6 +34585,46 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E 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 @@ -34267,6 +34888,75 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-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 @@ -34709,6 +35399,102 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (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) @@ -34865,34 +35651,55 @@ SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, C ENDIF END SUBROUTINE FAST_CopyOrcaFlex_Data - SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOrcaFlex_Data' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL Orca_DestroyInput( OrcaFlex_DataData%u, ErrStat, ErrMsg ) - CALL Orca_DestroyOutput( OrcaFlex_DataData%y, ErrStat, ErrMsg ) - CALL Orca_DestroyMisc( OrcaFlex_DataData%m, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL Orca_DestroyInput( OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OrcaFlex_DataData%Input) ENDIF @@ -36351,6 +37158,12 @@ SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, C 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 @@ -36447,76 +37260,111 @@ SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, C IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyModuleMapType - SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModuleMapType' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_W_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_W_P_2_ED_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_M_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_P_2_ED_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%Mooring_P_2_ED_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%Mooring_P_2_SD_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SD_TP, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_TP_2_ED_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_HD_M_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_P_2_SD_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_HD_W_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_W_P_2_SD_P, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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) @@ -36524,7 +37372,8 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -36532,7 +37381,8 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -36540,76 +37390,95 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_P_2_ED_P_N, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_AD_L_T, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat, ErrMsg ) + 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_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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%IceF_P_2_SD_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat, ErrMsg ) + 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%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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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 @@ -36622,43 +37491,64 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) IF (ALLOCATED(ModuleMapTypeData%Jac_u_indx)) THEN DEALLOCATE(ModuleMapTypeData%Jac_u_indx) ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_ED_NacelleLoads, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh_2, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_SD_LMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_SD_LMesh_2, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_HD_M_Mesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_HD_W_Mesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat, ErrMsg ) + 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 ) @@ -37645,6 +38535,40 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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) @@ -39574,6 +40498,62 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = 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 @@ -42369,6 +43349,86 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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) @@ -43025,15 +44085,27 @@ SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeD DstExternInputTypeData%CableDeltaLdot = SrcExternInputTypeData%CableDeltaLdot END SUBROUTINE FAST_CopyExternInputType - SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_ExternInputType), INTENT(INOUT) :: ExternInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInputType' + LOGICAL,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 ) @@ -43241,17 +44313,31 @@ SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyMisc - SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMisc' + LOGICAL,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 = "" - CALL FAST_Destroyexterninputtype( MiscData%ExternInput, ErrStat, ErrMsg ) - CALL FAST_Destroymisclintype( MiscData%Lin, ErrStat, 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 ) @@ -43701,52 +44787,96 @@ SUBROUTINE FAST_CopyInitData( SrcInitDataData, DstInitDataData, CtrlCode, ErrSta IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyInitData - SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_InitData), INTENT(INOUT) :: InitDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInitData' + LOGICAL,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 = "" - CALL ED_DestroyInitInput( InitDataData%InData_ED, ErrStat, ErrMsg ) - CALL ED_DestroyInitOutput( InitDataData%OutData_ED, ErrStat, ErrMsg ) - CALL BD_DestroyInitInput( InitDataData%InData_BD, ErrStat, 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) - CALL SrvD_DestroyInitOutput( InitDataData%OutData_SrvD, ErrStat, ErrMsg ) - CALL AD14_DestroyInitInput( InitDataData%InData_AD14, ErrStat, ErrMsg ) - CALL AD14_DestroyInitOutput( InitDataData%OutData_AD14, ErrStat, ErrMsg ) - CALL AD_DestroyInitInput( InitDataData%InData_AD, ErrStat, ErrMsg ) - CALL AD_DestroyInitOutput( InitDataData%OutData_AD, ErrStat, ErrMsg ) - CALL InflowWind_DestroyInitInput( InitDataData%InData_IfW, ErrStat, ErrMsg ) - CALL InflowWind_DestroyInitOutput( InitDataData%OutData_IfW, ErrStat, ErrMsg ) - CALL OpFM_DestroyInitInput( InitDataData%InData_OpFM, ErrStat, ErrMsg ) - CALL OpFM_DestroyInitOutput( InitDataData%OutData_OpFM, ErrStat, ErrMsg ) - CALL HydroDyn_DestroyInitInput( InitDataData%InData_HD, ErrStat, ErrMsg ) - CALL HydroDyn_DestroyInitOutput( InitDataData%OutData_HD, ErrStat, ErrMsg ) - CALL SD_DestroyInitInput( InitDataData%InData_SD, ErrStat, ErrMsg ) - CALL SD_DestroyInitOutput( InitDataData%OutData_SD, ErrStat, ErrMsg ) - CALL ExtPtfm_DestroyInitInput( InitDataData%InData_ExtPtfm, ErrStat, ErrMsg ) - CALL ExtPtfm_DestroyInitOutput( InitDataData%OutData_ExtPtfm, ErrStat, ErrMsg ) - CALL MAP_DestroyInitInput( InitDataData%InData_MAP, ErrStat, ErrMsg ) - CALL MAP_DestroyInitOutput( InitDataData%OutData_MAP, ErrStat, ErrMsg ) - CALL FEAM_DestroyInitInput( InitDataData%InData_FEAM, ErrStat, ErrMsg ) - CALL FEAM_DestroyInitOutput( InitDataData%OutData_FEAM, ErrStat, ErrMsg ) - CALL MD_DestroyInitInput( InitDataData%InData_MD, ErrStat, ErrMsg ) - CALL MD_DestroyInitOutput( InitDataData%OutData_MD, ErrStat, ErrMsg ) - CALL Orca_DestroyInitInput( InitDataData%InData_Orca, ErrStat, ErrMsg ) - CALL Orca_DestroyInitOutput( InitDataData%OutData_Orca, ErrStat, ErrMsg ) - CALL IceFloe_DestroyInitInput( InitDataData%InData_IceF, ErrStat, ErrMsg ) - CALL IceFloe_DestroyInitOutput( InitDataData%OutData_IceF, ErrStat, ErrMsg ) - CALL IceD_DestroyInitInput( InitDataData%InData_IceD, ErrStat, ErrMsg ) - CALL IceD_DestroyInitOutput( InitDataData%OutData_IceD, ErrStat, ErrMsg ) + 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 ) @@ -46618,6 +47748,7 @@ SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData DstExternInitTypeData%LidRadialVel = SrcExternInitTypeData%LidRadialVel DstExternInitTypeData%TurbineID = SrcExternInitTypeData%TurbineID DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos + DstExternInitTypeData%WaveFieldMod = SrcExternInitTypeData%WaveFieldMod DstExternInitTypeData%NumSC2CtrlGlob = SrcExternInitTypeData%NumSC2CtrlGlob DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC @@ -46654,15 +47785,27 @@ SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower END SUBROUTINE FAST_CopyExternInitType - SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_ExternInitType), INTENT(INOUT) :: ExternInitTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInitType' + LOGICAL,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 @@ -46711,6 +47854,7 @@ SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 1 ! LidRadialVel Int_BufSz = Int_BufSz + 1 ! TurbineID 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 @@ -46770,6 +47914,8 @@ SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 @@ -46871,6 +48017,8 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt 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) @@ -47023,36 +48171,69 @@ SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyTurbineType - SUBROUTINE FAST_DestroyTurbineType( TurbineTypeData, ErrStat, ErrMsg ) + SUBROUTINE FAST_DestroyTurbineType( TurbineTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(FAST_TurbineType), INTENT(INOUT) :: TurbineTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyTurbineType' + LOGICAL,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 = "" - CALL FAST_DestroyParam( TurbineTypeData%p_FAST, ErrStat, ErrMsg ) - CALL FAST_Destroyoutputfiletype( TurbineTypeData%y_FAST, ErrStat, ErrMsg ) - CALL FAST_DestroyMisc( TurbineTypeData%m_FAST, ErrStat, ErrMsg ) - CALL FAST_Destroymodulemaptype( TurbineTypeData%MeshMapData, ErrStat, ErrMsg ) - CALL FAST_Destroyelastodyn_data( TurbineTypeData%ED, ErrStat, ErrMsg ) - CALL FAST_Destroybeamdyn_data( TurbineTypeData%BD, ErrStat, ErrMsg ) - CALL FAST_Destroyservodyn_data( TurbineTypeData%SrvD, ErrStat, ErrMsg ) - CALL FAST_Destroyaerodyn_data( TurbineTypeData%AD, ErrStat, ErrMsg ) - CALL FAST_Destroyaerodyn14_data( TurbineTypeData%AD14, ErrStat, ErrMsg ) - CALL FAST_Destroyinflowwind_data( TurbineTypeData%IfW, ErrStat, ErrMsg ) - CALL FAST_Destroyopenfoam_data( TurbineTypeData%OpFM, ErrStat, ErrMsg ) - CALL FAST_Destroyscdataex_data( TurbineTypeData%SC_DX, ErrStat, ErrMsg ) - CALL FAST_Destroyhydrodyn_data( TurbineTypeData%HD, ErrStat, ErrMsg ) - CALL FAST_Destroysubdyn_data( TurbineTypeData%SD, ErrStat, ErrMsg ) - CALL FAST_Destroymap_data( TurbineTypeData%MAP, ErrStat, ErrMsg ) - CALL FAST_Destroyfeamooring_data( TurbineTypeData%FEAM, ErrStat, ErrMsg ) - CALL FAST_Destroymoordyn_data( TurbineTypeData%MD, ErrStat, ErrMsg ) - CALL FAST_Destroyorcaflex_data( TurbineTypeData%Orca, ErrStat, ErrMsg ) - CALL FAST_Destroyicefloe_data( TurbineTypeData%IceF, ErrStat, ErrMsg ) - CALL FAST_Destroyicedyn_data( TurbineTypeData%IceD, ErrStat, ErrMsg ) - CALL FAST_Destroyextptfm_data( TurbineTypeData%ExtPtfm, ErrStat, 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 ) diff --git a/modules/openfast-registry/src/data.h b/modules/openfast-registry/src/data.h index bc81980c73..4680d1539e 100644 --- a/modules/openfast-registry/src/data.h +++ b/modules/openfast-registry/src/data.h @@ -76,6 +76,8 @@ typedef struct node_struct { int is_interface_type ; +/* array pointer instead of allocatable*/ + int is_pointer; /* 0 = allocatable, 1 = pointer */ /* marker */ int mark ; diff --git a/modules/openfast-registry/src/gen_module_files.c b/modules/openfast-registry/src/gen_module_files.c index e0438498bd..153be2b659 100644 --- a/modules/openfast-registry/src/gen_module_files.c +++ b/modules/openfast-registry/src/gen_module_files.c @@ -146,7 +146,14 @@ gen_copy_f2c(FILE *fp, // *.f90 file we are writting to fprintf(fp, " ELSE\n"); fprintf(fp, " %sData%%c_obj%%%s_Len = SIZE(%sData%%%s)\n", nonick, r->name, nonick, r->name); fprintf(fp, " IF (%sData%%c_obj%%%s_Len > 0) &\n", nonick, r->name); - fprintf(fp, " %sData%%c_obj%%%s = C_LOC( %sData%%%s( LBOUND(%sData%%%s,1) ) ) \n", nonick, r->name, nonick, r->name, nonick, r->name ); + + fprintf(fp, " %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"); } @@ -241,7 +248,14 @@ gen_copy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong, con if ( sw_ccode && is_pointer(r) ) { // bjj: this needs to be updated if we've got multiple dimension arrays fprintf(fp," Dst%sData%%c_obj%%%s_Len = SIZE(Dst%sData%%%s)\n",nonick,r->name,nonick,r->name) ; fprintf(fp," IF (Dst%sData%%c_obj%%%s_Len > 0) &\n",nonick,r->name) ; - fprintf(fp," Dst%sData%%c_obj%%%s = C_LOC( Dst%sData%%%s(i1_l) ) \n",nonick,r->name, nonick,r->name ) ; + + fprintf(fp, " 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 @@ -734,7 +748,14 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) if (sw_ccode && is_pointer(r)) { // bjj: this needs to be updated if we've got multiple dimension arrays fprintf(fp, " OutData%%c_obj%%%s_Len = SIZE(OutData%%%s)\n", r->name, r->name); fprintf(fp, " IF (OutData%%c_obj%%%s_Len > 0) &\n", r->name); - fprintf(fp, " OutData%%c_obj%%%s = C_LOC( OutData%%%s(i1_l) ) \n", r->name, r->name); + + 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, " "); } @@ -945,15 +966,26 @@ gen_destroy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - fprintf(fp, " SUBROUTINE %s_Destroy%s( %sData, ErrStat, ErrMsg )\n",ModName->nickname,nonick,nonick ); + fprintf(fp, " 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, " CHARACTER(*), PARAMETER :: RoutineName = '%s_Destroy%s'\n", ModName->nickname, nonick); + fprintf(fp, " LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers\n"); + fprintf(fp, " \n"); fprintf(fp, " INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 \n"); - fprintf(fp,"! \n") ; - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp, " ErrMsg = \"\"\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) ; @@ -979,16 +1011,20 @@ gen_destroy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) } if (!strcmp(r->type->name, "meshtype")) { - fprintf(fp, " CALL MeshDestroy( %sData%%%s%s, ErrStat, ErrMsg )\n", nonick, r->name, dimstr(r->ndims)); + 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, ErrStat, ErrMsg )\n", nonick, r->name, dimstr(r->ndims)); + 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, ErrStat, ErrMsg )\n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), nonick, r->name, dimstr(r->ndims)); + 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--) { @@ -996,6 +1032,9 @@ gen_destroy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) } } 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) ; @@ -2126,7 +2165,7 @@ gen_module( FILE * fp , node_t * ModName, char * prog_ver ) } } - if ( is_pointer(r) ) { + if (sw_ccode && is_pointer(r) ) { fprintf(fp," %s ",c_types_binding(r->type->mapsto) ) ; } else { fprintf(fp," %s ",r->type->mapsto ) ; @@ -2256,9 +2295,11 @@ gen_module( FILE * fp , node_t * ModName, char * prog_ver ) gen_ExtrapInterp(fp, ModName, "UA_BL_Type", "UA_BL_Type", "ReKi"); } else if (!sw_noextrap) { if (strcmp(make_lower_temp(ModName->name), "dbemt") == 0) { // make interpolation routines for element-level DBEMT module - gen_ExtrapInterp(fp, ModName, "ElementInputType", "ElementInputType", "DbKi"); } +// else if (strcmp(make_lower_temp(ModName->name), "bemt") == 0) { +// gen_ExtrapInterp(fp, ModName, "SkewWake_InputType", "SkewWake_InputType", "DbKi"); +// } gen_ExtrapInterp(fp, ModName, "Input", "InputType", "DbKi"); gen_ExtrapInterp(fp, ModName, "Output", "OutputType", "DbKi"); diff --git a/modules/openfast-registry/src/reg_parse.c b/modules/openfast-registry/src/reg_parse.c index ab645697cb..ccacae580c 100644 --- a/modules/openfast-registry/src/reg_parse.c +++ b/modules/openfast-registry/src/reg_parse.c @@ -468,7 +468,45 @@ reg_parse( FILE * infile ) 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 @@ -561,12 +599,13 @@ 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] == '(' ) + 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:&(dimspec[9]) ; + p = (isNum(dimspec[0])||dimspec[0]==':'||dimspec[0]=='*'||dimspec[0]=='(')?dimspec:&(dimspec[9]) ; /* check for colon */ if (( colon = index(p,':')) != NULL ) { @@ -584,6 +623,13 @@ set_dim_len ( char * dimspec , node_t * dim_entry ) } 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 ; diff --git a/modules/openfast-registry/src/type.c b/modules/openfast-registry/src/type.c index 310d7b793d..5c3f19ace2 100644 --- a/modules/openfast-registry/src/type.c +++ b/modules/openfast-registry/src/type.c @@ -137,7 +137,9 @@ assoc_or_allocated( node_t * r ) 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 diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index cea50b0c4a..a90d1af01a 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -233,7 +233,7 @@ SUBROUTINE OpFM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err 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) ) + DstInitInputData%c_obj%StructBldRNodes = C_LOC( DstInitInputData%StructBldRNodes( i1_l ) ) END IF DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes ENDIF @@ -248,7 +248,7 @@ SUBROUTINE OpFM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err 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) ) + DstInitInputData%c_obj%StructTwrHNodes = C_LOC( DstInitInputData%StructTwrHNodes( i1_l ) ) END IF DstInitInputData%StructTwrHNodes = SrcInitInputData%StructTwrHNodes ENDIF @@ -260,22 +260,36 @@ SUBROUTINE OpFM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%C_obj%TowerBaseHeight = SrcInitInputData%C_obj%TowerBaseHeight END SUBROUTINE OpFM_CopyInitInput - SUBROUTINE OpFM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInitInput' + LOGICAL,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 @@ -452,7 +466,7 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -473,7 +487,7 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) + 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 @@ -556,7 +570,7 @@ SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers 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) ) ) + InitInputData%c_obj%StructBldRNodes = C_LOC( InitInputData%StructBldRNodes( LBOUND(InitInputData%StructBldRNodes,1) ) ) END IF END IF @@ -568,7 +582,7 @@ SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers 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) ) ) + InitInputData%c_obj%StructTwrHNodes = C_LOC( InitInputData%StructTwrHNodes( LBOUND(InitInputData%StructTwrHNodes,1) ) ) END IF END IF InitInputData%C_obj%BladeLength = InitInputData%BladeLength @@ -620,22 +634,35 @@ SUBROUTINE OpFM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE OpFM_CopyInitOutput - SUBROUTINE OpFM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInitOutput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 ) @@ -1082,60 +1109,80 @@ SUBROUTINE OpFM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE OpFM_CopyMisc - SUBROUTINE OpFM_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyMisc' + LOGICAL,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%ActForceLoads)) THEN DO i1 = LBOUND(MiscData%ActForceLoads,1), UBOUND(MiscData%ActForceLoads,1) - CALL MeshDestroy( MiscData%ActForceLoads(i1), ErrStat, ErrMsg ) + CALL MeshDestroy( MiscData%ActForceLoads(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%ActForceLoads) ENDIF IF (ALLOCATED(MiscData%ActForceMotions)) THEN DO i1 = LBOUND(MiscData%ActForceMotions,1), UBOUND(MiscData%ActForceMotions,1) - CALL MeshDestroy( MiscData%ActForceMotions(i1), ErrStat, ErrMsg ) + CALL MeshDestroy( MiscData%ActForceMotions(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%ActForceMotions) ENDIF IF (ALLOCATED(MiscData%ActForceMotionsPoints)) THEN DO i1 = LBOUND(MiscData%ActForceMotionsPoints,1), UBOUND(MiscData%ActForceMotionsPoints,1) - CALL MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL MeshDestroy( MiscData%ActForceLoadsPoints(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%ActForceLoadsPoints) ENDIF IF (ALLOCATED(MiscData%Line2_to_Line2_Loads)) THEN DO i1 = LBOUND(MiscData%Line2_to_Line2_Loads,1), UBOUND(MiscData%Line2_to_Line2_Loads,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Line2_to_Line2_Loads(i1), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( MiscData%Line2_to_Line2_Loads(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%Line2_to_Line2_Loads) ENDIF IF (ALLOCATED(MiscData%Line2_to_Line2_Motions)) THEN DO i1 = LBOUND(MiscData%Line2_to_Line2_Motions,1), UBOUND(MiscData%Line2_to_Line2_Motions,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Line2_to_Line2_Motions(i1), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( MiscData%Line2_to_Line2_Motions(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%Line2_to_Line2_Motions) ENDIF IF (ALLOCATED(MiscData%Line2_to_Point_Loads)) THEN DO i1 = LBOUND(MiscData%Line2_to_Point_Loads,1), UBOUND(MiscData%Line2_to_Point_Loads,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Line2_to_Point_Loads(i1), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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 @@ -2271,7 +2318,7 @@ SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg 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) ) + DstParamData%c_obj%forceBldRnodes = C_LOC( DstParamData%forceBldRnodes( i1_l ) ) END IF DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes ENDIF @@ -2286,7 +2333,7 @@ SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg 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) ) + DstParamData%c_obj%forceTwrHnodes = C_LOC( DstParamData%forceTwrHnodes( i1_l ) ) END IF DstParamData%forceTwrHnodes = SrcParamData%forceTwrHnodes ENDIF @@ -2298,22 +2345,36 @@ SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%C_obj%TowerBaseHeight = SrcParamData%C_obj%TowerBaseHeight END SUBROUTINE OpFM_CopyParam - SUBROUTINE OpFM_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyParam' + LOGICAL,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 @@ -2520,7 +2581,7 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -2541,7 +2602,7 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -2634,7 +2695,7 @@ SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + ParamData%c_obj%forceBldRnodes = C_LOC( ParamData%forceBldRnodes( LBOUND(ParamData%forceBldRnodes,1) ) ) END IF END IF @@ -2646,7 +2707,7 @@ SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + ParamData%c_obj%forceTwrHnodes = C_LOC( ParamData%forceTwrHnodes( LBOUND(ParamData%forceTwrHnodes,1) ) ) END IF END IF ParamData%C_obj%BladeLength = ParamData%BladeLength @@ -2680,7 +2741,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%pxVel = C_LOC( DstInputData%pxVel( i1_l ) ) END IF DstInputData%pxVel = SrcInputData%pxVel ENDIF @@ -2695,7 +2756,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%pyVel = C_LOC( DstInputData%pyVel( i1_l ) ) END IF DstInputData%pyVel = SrcInputData%pyVel ENDIF @@ -2710,7 +2771,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%pzVel = C_LOC( DstInputData%pzVel( i1_l ) ) END IF DstInputData%pzVel = SrcInputData%pzVel ENDIF @@ -2725,7 +2786,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%pxForce = C_LOC( DstInputData%pxForce( i1_l ) ) END IF DstInputData%pxForce = SrcInputData%pxForce ENDIF @@ -2740,7 +2801,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%pyForce = C_LOC( DstInputData%pyForce( i1_l ) ) END IF DstInputData%pyForce = SrcInputData%pyForce ENDIF @@ -2755,7 +2816,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%pzForce = C_LOC( DstInputData%pzForce( i1_l ) ) END IF DstInputData%pzForce = SrcInputData%pzForce ENDIF @@ -2770,7 +2831,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%xdotForce = C_LOC( DstInputData%xdotForce( i1_l ) ) END IF DstInputData%xdotForce = SrcInputData%xdotForce ENDIF @@ -2785,7 +2846,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%ydotForce = C_LOC( DstInputData%ydotForce( i1_l ) ) END IF DstInputData%ydotForce = SrcInputData%ydotForce ENDIF @@ -2800,7 +2861,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%zdotForce = C_LOC( DstInputData%zdotForce( i1_l ) ) END IF DstInputData%zdotForce = SrcInputData%zdotForce ENDIF @@ -2815,7 +2876,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%pOrientation = C_LOC( DstInputData%pOrientation( i1_l ) ) END IF DstInputData%pOrientation = SrcInputData%pOrientation ENDIF @@ -2830,7 +2891,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%fx = C_LOC( DstInputData%fx( i1_l ) ) END IF DstInputData%fx = SrcInputData%fx ENDIF @@ -2845,7 +2906,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%fy = C_LOC( DstInputData%fy( i1_l ) ) END IF DstInputData%fy = SrcInputData%fy ENDIF @@ -2860,7 +2921,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%fz = C_LOC( DstInputData%fz( i1_l ) ) END IF DstInputData%fz = SrcInputData%fz ENDIF @@ -2875,7 +2936,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%momentx = C_LOC( DstInputData%momentx( i1_l ) ) END IF DstInputData%momentx = SrcInputData%momentx ENDIF @@ -2890,7 +2951,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%momenty = C_LOC( DstInputData%momenty( i1_l ) ) END IF DstInputData%momenty = SrcInputData%momenty ENDIF @@ -2905,7 +2966,7 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + DstInputData%c_obj%momentz = C_LOC( DstInputData%momentz( i1_l ) ) END IF DstInputData%momentz = SrcInputData%momentz ENDIF @@ -2920,118 +2981,147 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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) ) + 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 ) + SUBROUTINE OpFM_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(OpFM_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInput' + LOGICAL,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 @@ -3487,7 +3577,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3508,7 +3598,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3529,7 +3619,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3550,7 +3640,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3571,7 +3661,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3592,7 +3682,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3613,7 +3703,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3634,7 +3724,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3655,7 +3745,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3676,7 +3766,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3697,7 +3787,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3718,7 +3808,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3739,7 +3829,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3760,7 +3850,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3781,7 +3871,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3802,7 +3892,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -3823,7 +3913,7 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) + 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 @@ -4025,7 +4115,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%pxVel = C_LOC( InputData%pxVel( LBOUND(InputData%pxVel,1) ) ) END IF END IF @@ -4037,7 +4127,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%pyVel = C_LOC( InputData%pyVel( LBOUND(InputData%pyVel,1) ) ) END IF END IF @@ -4049,7 +4139,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%pzVel = C_LOC( InputData%pzVel( LBOUND(InputData%pzVel,1) ) ) END IF END IF @@ -4061,7 +4151,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%pxForce = C_LOC( InputData%pxForce( LBOUND(InputData%pxForce,1) ) ) END IF END IF @@ -4073,7 +4163,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%pyForce = C_LOC( InputData%pyForce( LBOUND(InputData%pyForce,1) ) ) END IF END IF @@ -4085,7 +4175,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%pzForce = C_LOC( InputData%pzForce( LBOUND(InputData%pzForce,1) ) ) END IF END IF @@ -4097,7 +4187,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%xdotForce = C_LOC( InputData%xdotForce( LBOUND(InputData%xdotForce,1) ) ) END IF END IF @@ -4109,7 +4199,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%ydotForce = C_LOC( InputData%ydotForce( LBOUND(InputData%ydotForce,1) ) ) END IF END IF @@ -4121,7 +4211,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%zdotForce = C_LOC( InputData%zdotForce( LBOUND(InputData%zdotForce,1) ) ) END IF END IF @@ -4133,7 +4223,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%pOrientation = C_LOC( InputData%pOrientation( LBOUND(InputData%pOrientation,1) ) ) END IF END IF @@ -4145,7 +4235,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%fx = C_LOC( InputData%fx( LBOUND(InputData%fx,1) ) ) END IF END IF @@ -4157,7 +4247,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%fy = C_LOC( InputData%fy( LBOUND(InputData%fy,1) ) ) END IF END IF @@ -4169,7 +4259,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%fz = C_LOC( InputData%fz( LBOUND(InputData%fz,1) ) ) END IF END IF @@ -4181,7 +4271,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%momentx = C_LOC( InputData%momentx( LBOUND(InputData%momentx,1) ) ) END IF END IF @@ -4193,7 +4283,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%momenty = C_LOC( InputData%momenty( LBOUND(InputData%momenty,1) ) ) END IF END IF @@ -4205,7 +4295,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%momentz = C_LOC( InputData%momentz( LBOUND(InputData%momentz,1) ) ) END IF END IF @@ -4217,7 +4307,7 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%forceNodesChord = C_LOC( InputData%forceNodesChord( LBOUND(InputData%forceNodesChord,1) ) ) END IF END IF END SUBROUTINE OpFM_F2C_CopyInput @@ -4248,7 +4338,7 @@ SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err 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) ) + DstOutputData%c_obj%u = C_LOC( DstOutputData%u( i1_l ) ) END IF DstOutputData%u = SrcOutputData%u ENDIF @@ -4263,7 +4353,7 @@ SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err 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) ) + DstOutputData%c_obj%v = C_LOC( DstOutputData%v( i1_l ) ) END IF DstOutputData%v = SrcOutputData%v ENDIF @@ -4278,7 +4368,7 @@ SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err 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) ) + DstOutputData%c_obj%w = C_LOC( DstOutputData%w( i1_l ) ) END IF DstOutputData%w = SrcOutputData%w ENDIF @@ -4296,28 +4386,43 @@ SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE OpFM_CopyOutput - SUBROUTINE OpFM_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyOutput' + LOGICAL,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 @@ -4516,7 +4621,7 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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) ) + 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 @@ -4537,7 +4642,7 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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) ) + 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 @@ -4558,7 +4663,7 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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) ) + 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 @@ -4652,7 +4757,7 @@ SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + OutputData%c_obj%u = C_LOC( OutputData%u( LBOUND(OutputData%u,1) ) ) END IF END IF @@ -4664,7 +4769,7 @@ SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + OutputData%c_obj%v = C_LOC( OutputData%v( LBOUND(OutputData%v,1) ) ) END IF END IF @@ -4676,7 +4781,7 @@ SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + OutputData%c_obj%w = C_LOC( OutputData%w( LBOUND(OutputData%w,1) ) ) END IF END IF END SUBROUTINE OpFM_F2C_CopyOutput diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 index 9dcbcbaf90..04c49d6d76 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 @@ -40,11 +40,6 @@ MODULE OrcaFlexInterface_Parameters ! This code was generated by Write_ChckOutLst.m at 01-Sep-2015 14:29:18. - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - ! Indices for computing output channels: ! NOTES: ! (1) These parameters are in the order stored in "OutListParameters.xlsx" diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 51a40873d8..69d3c7a6ee 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -128,15 +128,27 @@ SUBROUTINE Orca_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%TMax = SrcInitInputData%TMax END SUBROUTINE Orca_CopyInitInput - SUBROUTINE Orca_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE Orca_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Orca_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInitInput' + LOGICAL,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 ) @@ -300,16 +312,29 @@ SUBROUTINE Orca_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ENDIF END SUBROUTINE Orca_CopyInitOutput - SUBROUTINE Orca_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE Orca_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Orca_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInitOutput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 @@ -602,15 +627,27 @@ SUBROUTINE Orca_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%DirRoot = SrcInputFileData%DirRoot END SUBROUTINE Orca_CopyInputFile - SUBROUTINE Orca_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE Orca_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Orca_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInputFile' + LOGICAL,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 ) @@ -767,15 +804,27 @@ SUBROUTINE Orca_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE Orca_CopyOtherState - SUBROUTINE Orca_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE Orca_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Orca_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyOtherState' + LOGICAL,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 ) @@ -909,15 +958,27 @@ SUBROUTINE Orca_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%LastTimeStep = SrcMiscData%LastTimeStep END SUBROUTINE Orca_CopyMisc - SUBROUTINE Orca_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE Orca_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Orca_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyMisc' + LOGICAL,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 @@ -1137,19 +1198,33 @@ SUBROUTINE Orca_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE Orca_CopyParam - SUBROUTINE Orca_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE Orca_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Orca_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyParam' + LOGICAL,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 = "" - CALL FreeDynamicLib( ParamData%DLL_Orca, ErrStat, 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), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -1497,16 +1572,29 @@ SUBROUTINE Orca_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Orca_CopyInput - SUBROUTINE Orca_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE Orca_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Orca_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInput' + LOGICAL,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 = "" - CALL MeshDestroy( InputData%PtfmMesh, ErrStat, 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 ) @@ -1719,16 +1807,29 @@ SUBROUTINE Orca_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE Orca_CopyOutput - SUBROUTINE Orca_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE Orca_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Orca_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyOutput' + LOGICAL,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 = "" - CALL MeshDestroy( OutputData%PtfmMesh, ErrStat, 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 @@ -1968,15 +2069,27 @@ SUBROUTINE Orca_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err DstContStateData%Dummy = SrcContStateData%Dummy END SUBROUTINE Orca_CopyContState - SUBROUTINE Orca_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE Orca_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyContState' + LOGICAL,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 ) @@ -2093,15 +2206,27 @@ SUBROUTINE Orca_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err DstDiscStateData%Dummy = SrcDiscStateData%Dummy END SUBROUTINE Orca_CopyDiscState - SUBROUTINE Orca_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE Orca_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyDiscState' + LOGICAL,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 ) @@ -2218,15 +2343,27 @@ SUBROUTINE Orca_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE Orca_CopyConstrState - SUBROUTINE Orca_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE Orca_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyConstrState' + LOGICAL,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 ) diff --git a/modules/servodyn/src/ServoDyn_IO.f90 b/modules/servodyn/src/ServoDyn_IO.f90 index 805b2be99e..cb900579ec 100644 --- a/modules/servodyn/src/ServoDyn_IO.f90 +++ b/modules/servodyn/src/ServoDyn_IO.f90 @@ -39,11 +39,6 @@ MODULE ServoDyn_IO ! This code was generated by Write_ChckOutLst.m at 04-Feb-2021 08:42:27. - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - ! Indices for computing output channels: ! NOTES: ! (1) These parameters are in the order stored in "OutListParameters.xlsx" @@ -1461,8 +1456,7 @@ subroutine ParseInputFileInfo( PriPath, InputFile, OutFileRoot, FileInfo_In, Inp !---------------------- OUTLIST -------------------------------------------- if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 - call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%OutList, & - InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEcho ) + call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%OutList, InputFileData%NumOuts, ErrStat2, ErrMsg2, UnEcho ) if (Failed()) return; diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 801601b2e3..77751beeac 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -709,15 +709,27 @@ SUBROUTINE SrvD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err ENDIF END SUBROUTINE SrvD_CopyInitInput - SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInitInput' + LOGICAL,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 @@ -733,7 +745,8 @@ SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitInputData%BladeRootRefOrient)) THEN DEALLOCATE(InitInputData%BladeRootRefOrient) ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat, ErrMsg ) + 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 @@ -1703,22 +1716,35 @@ SUBROUTINE SrvD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ENDIF END SUBROUTINE SrvD_CopyInitOutput - SUBROUTINE SrvD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInitOutput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 @@ -2515,15 +2541,27 @@ SUBROUTINE SrvD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%EXavrSWAP = SrcInputFileData%EXavrSWAP END SUBROUTINE SrvD_CopyInputFile - SUBROUTINE SrvD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInputFile' + LOGICAL,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 @@ -3719,15 +3757,27 @@ SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, C ENDIF END SUBROUTINE SrvD_CopyBladedDLLType - SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(BladedDLLType), INTENT(INOUT) :: BladedDLLTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyBladedDLLType' + LOGICAL,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 @@ -3736,7 +3786,8 @@ SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(BladedDLLTypeData%LogChannels_OutParam)) THEN DO i1 = LBOUND(BladedDLLTypeData%LogChannels_OutParam,1), UBOUND(BladedDLLTypeData%LogChannels_OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat, ErrMsg ) + 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 @@ -5326,36 +5377,52 @@ SUBROUTINE SrvD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err ENDIF END SUBROUTINE SrvD_CopyContState - SUBROUTINE SrvD_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyContState' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL StC_DestroyContState( ContStateData%SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%SStC) ENDIF @@ -6022,36 +6089,52 @@ SUBROUTINE SrvD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err ENDIF END SUBROUTINE SrvD_CopyDiscState - SUBROUTINE SrvD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyDiscState' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL StC_DestroyDiscState( DiscStateData%SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DiscStateData%SStC) ENDIF @@ -6718,36 +6801,52 @@ SUBROUTINE SrvD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod ENDIF END SUBROUTINE SrvD_CopyConstrState - SUBROUTINE SrvD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyConstrState' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL StC_DestroyConstrState( ConstrStateData%SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ConstrStateData%SStC) ENDIF @@ -7491,15 +7590,27 @@ SUBROUTINE SrvD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ENDIF END SUBROUTINE SrvD_CopyOtherState - SUBROUTINE SrvD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyOtherState' + LOGICAL,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 @@ -7520,25 +7631,29 @@ SUBROUTINE SrvD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(OtherStateData%BStC)) THEN DO i1 = LBOUND(OtherStateData%BStC,1), UBOUND(OtherStateData%BStC,1) - CALL StC_DestroyOtherState( OtherStateData%BStC(i1), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL StC_DestroyOtherState( OtherStateData%SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%SStC) ENDIF @@ -8530,64 +8645,84 @@ SUBROUTINE SrvD_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, C ENDIF END SUBROUTINE SrvD_CopyModuleMapType - SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyModuleMapType' + LOGICAL,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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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 @@ -9920,47 +10055,65 @@ SUBROUTINE SrvD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall END SUBROUTINE SrvD_CopyMisc - SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyMisc' + LOGICAL,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 = "" - CALL SrvD_Destroybladeddlltype( MiscData%dll_data, ErrStat, 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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) @@ -9968,7 +10121,8 @@ SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -9976,7 +10130,8 @@ SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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) @@ -9984,36 +10139,42 @@ SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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 ) @@ -12315,15 +12476,27 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE SrvD_CopyParam - SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyParam' + LOGICAL,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 @@ -12341,32 +12514,38 @@ SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) + 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, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL StC_DestroyParam( ParamData%SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%SStC) ENDIF @@ -14887,15 +15066,27 @@ SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE SrvD_CopyInput - SUBROUTINE SrvD_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInput' + LOGICAL,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 @@ -14920,30 +15111,35 @@ SUBROUTINE SrvD_DestroyInput( InputData, ErrStat, ErrMsg ) IF (ALLOCATED(InputData%Lidar)) THEN DEALLOCATE(InputData%Lidar) ENDIF - CALL MeshDestroy( InputData%PtfmMotionMesh, ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputData%SStCMotionMesh) ENDIF @@ -16293,15 +16489,27 @@ SUBROUTINE SrvD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE SrvD_CopyOutput - SUBROUTINE SrvD_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE SrvD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SrvD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyOutput' + LOGICAL,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 @@ -16326,26 +16534,30 @@ SUBROUTINE SrvD_DestroyOutput( OutputData, ErrStat, ErrMsg ) 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%SStCLoadMesh) ENDIF @@ -17456,7 +17668,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg b = -(u1%LSShftFys - u2%LSShftFys) u_out%LSShftFys = u1%LSShftFys + b * ScaleFactor b = -(u1%LSShftFzs - u2%LSShftFzs) - u_out%LSShftFzs = u1%LSShftFzs + b * ScaleFactor + 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)) @@ -17688,7 +17900,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er 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 + 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 diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index d8bc847c52..3f5dd2582c 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -371,15 +371,27 @@ SUBROUTINE StC_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrS ENDIF END SUBROUTINE StC_CopyInputFile - SUBROUTINE StC_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInputFile' + LOGICAL,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 @@ -1042,15 +1054,27 @@ SUBROUTINE StC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE StC_CopyInitInput - SUBROUTINE StC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInitInput' + LOGICAL,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 @@ -1063,8 +1087,10 @@ SUBROUTINE StC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitInputData%InitRefOrient)) THEN DEALLOCATE(InitInputData%InitRefOrient) ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrescribeFrcData, ErrStat, ErrMsg ) + 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 ) @@ -1703,15 +1729,27 @@ SUBROUTINE StC_CopyCtrlChanInitInfoType( SrcCtrlChanInitInfoTypeData, DstCtrlCha ENDIF END SUBROUTINE StC_CopyCtrlChanInitInfoType - SUBROUTINE StC_DestroyCtrlChanInitInfoType( CtrlChanInitInfoTypeData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyCtrlChanInitInfoType( CtrlChanInitInfoTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_CtrlChanInitInfoType), INTENT(INOUT) :: CtrlChanInitInfoTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyCtrlChanInitInfoType' + LOGICAL,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 @@ -2191,15 +2229,27 @@ SUBROUTINE StC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E ENDIF END SUBROUTINE StC_CopyInitOutput - SUBROUTINE StC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInitOutput' + LOGICAL,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 @@ -2379,15 +2429,27 @@ SUBROUTINE StC_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrS ENDIF END SUBROUTINE StC_CopyContState - SUBROUTINE StC_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyContState' + LOGICAL,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 @@ -2552,15 +2614,27 @@ SUBROUTINE StC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE StC_CopyDiscState - SUBROUTINE StC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyDiscState' + LOGICAL,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 ) @@ -2677,15 +2751,27 @@ SUBROUTINE StC_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE StC_CopyConstrState - SUBROUTINE StC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyConstrState' + LOGICAL,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 ) @@ -2802,15 +2888,27 @@ SUBROUTINE StC_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE StC_CopyOtherState - SUBROUTINE StC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyOtherState' + LOGICAL,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 ) @@ -3167,15 +3265,27 @@ SUBROUTINE StC_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%PrescribedInterpIdx = SrcMiscData%PrescribedInterpIdx END SUBROUTINE StC_CopyMisc - SUBROUTINE StC_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyMisc' + LOGICAL,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 @@ -4250,15 +4360,27 @@ SUBROUTINE StC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE StC_CopyParam - SUBROUTINE StC_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyParam' + LOGICAL,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 @@ -4862,18 +4984,31 @@ SUBROUTINE StC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE StC_CopyInput - SUBROUTINE StC_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInput' + LOGICAL,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), ErrStat, ErrMsg ) + CALL MeshDestroy( InputData%Mesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputData%Mesh) ENDIF @@ -5360,18 +5495,31 @@ SUBROUTINE StC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM ENDIF END SUBROUTINE StC_CopyOutput - SUBROUTINE StC_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE StC_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(StC_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyOutput' + LOGICAL,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), ErrStat, ErrMsg ) + CALL MeshDestroy( OutputData%Mesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%Mesh) ENDIF diff --git a/modules/subdyn/src/FEM.f90 b/modules/subdyn/src/FEM.f90 index ba74d2bf50..b8a9eed453 100644 --- a/modules/subdyn/src/FEM.f90 +++ b/modules/subdyn/src/FEM.f90 @@ -84,7 +84,7 @@ SUBROUTINE EigenSolve(K, M, N, bCheckSingularity, EigVect, Omega, ErrStat, ErrMs Omega2(:) =0.0_LaKi DO I=1,N !Initialize the key and calculate Omega KEY(I)=I - Omega2(I) = AlphaR(I)/Beta(I) + !Omega2(I) = AlphaR(I)/Beta(I) if ( EqualRealNos(real(Beta(I),ReKi),0.0_ReKi) ) then ! --- Beta =0 if (bCheckSingularity) call WrScr('[WARN] Large eigenvalue found, system may be ill-conditioned') diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index d35659a9df..4b53972dd0 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -369,15 +369,27 @@ SUBROUTINE SD_CopyIList( SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_CopyIList - SUBROUTINE SD_DestroyIList( IListData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyIList( IListData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(IList), INTENT(INOUT) :: IListData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyIList' + LOGICAL,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 @@ -643,15 +655,27 @@ SUBROUTINE SD_CopyMeshAuxDataType( SrcMeshAuxDataTypeData, DstMeshAuxDataTypeDat ENDIF END SUBROUTINE SD_CopyMeshAuxDataType - SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(MeshAuxDataType), INTENT(INOUT) :: MeshAuxDataTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMeshAuxDataType' + LOGICAL,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 @@ -1247,15 +1271,27 @@ SUBROUTINE SD_CopyCB_MatArrays( SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCo ENDIF END SUBROUTINE SD_CopyCB_MatArrays - SUBROUTINE SD_DestroyCB_MatArrays( CB_MatArraysData, ErrStat, ErrMsg ) + 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 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyCB_MatArrays' + LOGICAL,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 @@ -1680,15 +1716,27 @@ SUBROUTINE SD_CopyElemPropType( SrcElemPropTypeData, DstElemPropTypeData, CtrlCo DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos END SUBROUTINE SD_CopyElemPropType - SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(ElemPropType), INTENT(INOUT) :: ElemPropTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyElemPropType' + LOGICAL,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 ) @@ -1918,19 +1966,32 @@ SUBROUTINE SD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%Linearize = SrcInitInputData%Linearize END SUBROUTINE SD_CopyInitInput - SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitInput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 ) @@ -2373,22 +2434,35 @@ SUBROUTINE SD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er ENDIF END SUBROUTINE SD_CopyInitOutput - SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitOutput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 @@ -3437,15 +3511,27 @@ SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%SSSum = SrcInitTypeData%SSSum END SUBROUTINE SD_CopyInitType - SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SD_InitType), INTENT(INOUT) :: InitTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitType' + LOGICAL,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 @@ -5041,15 +5127,27 @@ SUBROUTINE SD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE SD_CopyContState - SUBROUTINE SD_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyContState' + LOGICAL,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 @@ -5244,15 +5342,27 @@ SUBROUTINE SD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE SD_CopyDiscState - SUBROUTINE SD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyDiscState' + LOGICAL,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 ) @@ -5369,15 +5479,27 @@ SUBROUTINE SD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE SD_CopyConstrState - SUBROUTINE SD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyConstrState' + LOGICAL,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 ) @@ -5511,18 +5633,31 @@ SUBROUTINE SD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%n = SrcOtherStateData%n END SUBROUTINE SD_CopyOtherState - SUBROUTINE SD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOtherState' + LOGICAL,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), ErrStat, ErrMsg ) + CALL SD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%xdot) ENDIF @@ -6009,15 +6144,27 @@ SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_CopyMisc - SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMisc' + LOGICAL,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 @@ -7842,21 +7989,34 @@ SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%RotStates = SrcParamData%RotStates END SUBROUTINE SD_CopyParam - SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyParam' + LOGICAL,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), ErrStat, ErrMsg ) + CALL SD_Destroyelemproptype( ParamData%ElemProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%ElemProps) ENDIF @@ -7877,13 +8037,15 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%NodesDOF)) THEN DO i1 = LBOUND(ParamData%NodesDOF,1), UBOUND(ParamData%NodesDOF,1) - CALL SD_Destroyilist( ParamData%NodesDOF(i1), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL SD_Destroyilist( ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%NodesDOFred) ENDIF @@ -8021,25 +8183,29 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%MoutLst)) THEN DO i1 = LBOUND(ParamData%MoutLst,1), UBOUND(ParamData%MoutLst,1) - CALL SD_Destroymeshauxdatatype( ParamData%MoutLst(i1), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + 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), ErrStat, ErrMsg ) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF @@ -11575,17 +11741,31 @@ SUBROUTINE SD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_CopyInput - SUBROUTINE SD_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInput' + LOGICAL,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 = "" - CALL MeshDestroy( InputData%TPMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( InputData%LMesh, ErrStat, 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 @@ -11931,18 +12111,33 @@ SUBROUTINE SD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE SD_CopyOutput - SUBROUTINE SD_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE SD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOutput' + LOGICAL,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 = "" - CALL MeshDestroy( OutputData%Y1Mesh, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%Y2Mesh, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%Y3Mesh, ErrStat, 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 diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 87f9b83253..2a44f59489 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -116,15 +116,27 @@ SUBROUTINE SC_DX_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%C_obj%NumCtrl2SC = SrcInitInputData%C_obj%NumCtrl2SC END SUBROUTINE SC_DX_CopyInitInput - SUBROUTINE SC_DX_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE SC_DX_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInitInput' + LOGICAL,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 ) @@ -299,16 +311,29 @@ SUBROUTINE SC_DX_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE SC_DX_CopyInitOutput - SUBROUTINE SC_DX_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE SC_DX_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInitOutput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 ) @@ -543,15 +568,27 @@ SUBROUTINE SC_DX_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%C_obj%useSC = SrcParamData%C_obj%useSC END SUBROUTINE SC_DX_CopyParam - SUBROUTINE SC_DX_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE SC_DX_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyParam' + LOGICAL,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 ) @@ -716,22 +753,35 @@ SUBROUTINE SC_DX_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs 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) ) + 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 ) + SUBROUTINE SC_DX_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInput' + LOGICAL,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 @@ -867,7 +917,7 @@ SUBROUTINE SC_DX_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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) ) + 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 @@ -925,7 +975,7 @@ SUBROUTINE SC_DX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) END IF END IF END SUBROUTINE SC_DX_F2C_CopyInput @@ -956,7 +1006,7 @@ SUBROUTINE SC_DX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er 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) ) + DstOutputData%c_obj%fromSC = C_LOC( DstOutputData%fromSC( i1_l ) ) END IF DstOutputData%fromSC = SrcOutputData%fromSC ENDIF @@ -971,28 +1021,42 @@ SUBROUTINE SC_DX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er 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) ) + 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 ) + SUBROUTINE SC_DX_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyOutput' + LOGICAL,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 @@ -1148,7 +1212,7 @@ SUBROUTINE SC_DX_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err 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) ) + 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 @@ -1169,7 +1233,7 @@ SUBROUTINE SC_DX_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err 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) ) + 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 @@ -1236,7 +1300,7 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + OutputData%c_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) END IF END IF @@ -1248,7 +1312,7 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + OutputData%c_obj%fromSCglob = C_LOC( OutputData%fromSCglob( LBOUND(OutputData%fromSCglob,1) ) ) END IF END IF END SUBROUTINE SC_DX_F2C_CopyOutput diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 06db9d3cdb..10ae1505c9 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -202,15 +202,27 @@ SUBROUTINE SC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%C_obj%DLL_FileName = SrcInitInputData%C_obj%DLL_FileName END SUBROUTINE SC_CopyInitInput - SUBROUTINE SC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE SC_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInitInput' + LOGICAL,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 ) @@ -389,16 +401,29 @@ SUBROUTINE SC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%C_obj%NumSC2CtrlGlob = SrcInitOutputData%C_obj%NumSC2CtrlGlob END SUBROUTINE SC_CopyInitOutput - SUBROUTINE SC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE SC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInitOutput' + LOGICAL,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 = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, 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 ) @@ -693,7 +718,7 @@ SUBROUTINE SC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) 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) ) + DstParamData%c_obj%ParamGlobal = C_LOC( DstParamData%ParamGlobal( i1_l ) ) END IF DstParamData%ParamGlobal = SrcParamData%ParamGlobal ENDIF @@ -708,35 +733,50 @@ SUBROUTINE SC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) 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) ) + 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 ) + SUBROUTINE SC_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyParam' + LOGICAL,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, ErrStat, ErrMsg ) + 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 ) @@ -993,7 +1033,7 @@ SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) + 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 @@ -1014,7 +1054,7 @@ SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) + 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 @@ -1141,7 +1181,7 @@ SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + ParamData%c_obj%ParamGlobal = C_LOC( ParamData%ParamGlobal( LBOUND(ParamData%ParamGlobal,1) ) ) END IF END IF @@ -1153,7 +1193,7 @@ SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + ParamData%c_obj%ParamTurbine = C_LOC( ParamData%ParamTurbine( LBOUND(ParamData%ParamTurbine,1) ) ) END IF END IF END SUBROUTINE SC_F2C_CopyParam @@ -1184,7 +1224,7 @@ SUBROUTINE SC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt 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) ) + DstDiscStateData%c_obj%Global = C_LOC( DstDiscStateData%Global( i1_l ) ) END IF DstDiscStateData%Global = SrcDiscStateData%Global ENDIF @@ -1199,28 +1239,42 @@ SUBROUTINE SC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt 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) ) + 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 ) + SUBROUTINE SC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyDiscState' + LOGICAL,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 @@ -1376,7 +1430,7 @@ SUBROUTINE SC_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err 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) ) + 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 @@ -1397,7 +1451,7 @@ SUBROUTINE SC_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err 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) ) + 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 @@ -1464,7 +1518,7 @@ SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + DiscStateData%c_obj%Global = C_LOC( DiscStateData%Global( LBOUND(DiscStateData%Global,1) ) ) END IF END IF @@ -1476,7 +1530,7 @@ SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + DiscStateData%c_obj%Turbine = C_LOC( DiscStateData%Turbine( LBOUND(DiscStateData%Turbine,1) ) ) END IF END IF END SUBROUTINE SC_F2C_CopyDiscState @@ -1499,15 +1553,27 @@ SUBROUTINE SC_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt DstContStateData%C_obj%Dummy = SrcContStateData%C_obj%Dummy END SUBROUTINE SC_CopyContState - SUBROUTINE SC_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE SC_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyContState' + LOGICAL,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 ) @@ -1664,15 +1730,27 @@ SUBROUTINE SC_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%C_obj%Dummy = SrcConstrStateData%C_obj%Dummy END SUBROUTINE SC_CopyConstrState - SUBROUTINE SC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE SC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyConstrState' + LOGICAL,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 ) @@ -1829,15 +1907,27 @@ SUBROUTINE SC_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%C_obj%Dummy = SrcMiscData%C_obj%Dummy END SUBROUTINE SC_CopyMisc - SUBROUTINE SC_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE SC_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyMisc' + LOGICAL,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 ) @@ -1994,15 +2084,27 @@ SUBROUTINE SC_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%Dummy = SrcOtherStateData%C_obj%Dummy END SUBROUTINE SC_CopyOtherState - SUBROUTINE SC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE SC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyOtherState' + LOGICAL,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 ) @@ -2167,7 +2269,7 @@ SUBROUTINE SC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) 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) ) + DstInputData%c_obj%toSCglob = C_LOC( DstInputData%toSCglob( i1_l ) ) END IF DstInputData%toSCglob = SrcInputData%toSCglob ENDIF @@ -2182,28 +2284,42 @@ SUBROUTINE SC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) 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) ) + 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 ) + SUBROUTINE SC_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInput' + LOGICAL,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 @@ -2359,7 +2475,7 @@ SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) + 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 @@ -2380,7 +2496,7 @@ SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) + 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 @@ -2447,7 +2563,7 @@ SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%toSCglob = C_LOC( InputData%toSCglob( LBOUND(InputData%toSCglob,1) ) ) END IF END IF @@ -2459,7 +2575,7 @@ SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + InputData%c_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) END IF END IF END SUBROUTINE SC_F2C_CopyInput @@ -2490,7 +2606,7 @@ SUBROUTINE SC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs 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) ) + DstOutputData%c_obj%fromSCglob = C_LOC( DstOutputData%fromSCglob( i1_l ) ) END IF DstOutputData%fromSCglob = SrcOutputData%fromSCglob ENDIF @@ -2505,28 +2621,42 @@ SUBROUTINE SC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs 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) ) + 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 ) + SUBROUTINE SC_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(SC_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyOutput' + LOGICAL,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 @@ -2682,7 +2812,7 @@ SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) + 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 @@ -2703,7 +2833,7 @@ SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) + 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 @@ -2770,7 +2900,7 @@ SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + OutputData%c_obj%fromSCglob = C_LOC( OutputData%fromSCglob( LBOUND(OutputData%fromSCglob,1) ) ) END IF END IF @@ -2782,7 +2912,7 @@ SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) 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) ) ) + OutputData%c_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) END IF END IF END SUBROUTINE SC_F2C_CopyOutput diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index b5a9c60fe2..cc2f29d437 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -212,15 +212,27 @@ SUBROUTINE WD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, Ctr DstInputFileTypeData%C_WakeDiam = SrcInputFileTypeData%C_WakeDiam END SUBROUTINE WD_CopyInputFileType - SUBROUTINE WD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) + SUBROUTINE WD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WD_InputFileType), INTENT(INOUT) :: InputFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInputFileType' + LOGICAL,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 ) @@ -442,16 +454,29 @@ SUBROUTINE WD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%TurbNum = SrcInitInputData%TurbNum END SUBROUTINE WD_CopyInitInput - SUBROUTINE WD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE WD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInitInput' + LOGICAL,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 = "" - CALL WD_Destroyinputfiletype( InitInputData%InputFileData, ErrStat, 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 ) @@ -681,22 +706,35 @@ SUBROUTINE WD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WD_CopyInitOutput - SUBROUTINE WD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE WD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInitOutput' + LOGICAL,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, ErrStat, ErrMsg ) + 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 ) @@ -979,15 +1017,27 @@ SUBROUTINE WD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE WD_CopyContState - SUBROUTINE WD_DestroyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE WD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyContState' + LOGICAL,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 ) @@ -1248,15 +1298,27 @@ SUBROUTINE WD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE WD_CopyDiscState - SUBROUTINE WD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE WD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyDiscState' + LOGICAL,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 @@ -1876,15 +1938,27 @@ SUBROUTINE WD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE WD_CopyConstrState - SUBROUTINE WD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE WD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyConstrState' + LOGICAL,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 ) @@ -2001,15 +2075,27 @@ SUBROUTINE WD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%firstPass = SrcOtherStateData%firstPass END SUBROUTINE WD_CopyOtherState - SUBROUTINE WD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE WD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyOtherState' + LOGICAL,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 ) @@ -2265,15 +2351,27 @@ SUBROUTINE WD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE WD_CopyMisc - SUBROUTINE WD_DestroyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE WD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyMisc' + LOGICAL,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%dvdr)) THEN DEALLOCATE(MiscData%dvdr) ENDIF @@ -2903,15 +3001,27 @@ SUBROUTINE WD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%C_WakeDiam = SrcParamData%C_WakeDiam END SUBROUTINE WD_CopyParam - SUBROUTINE WD_DestroyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE WD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyParam' + LOGICAL,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 @@ -3214,15 +3324,27 @@ SUBROUTINE WD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) DstInputData%YawErr = SrcInputData%YawErr END SUBROUTINE WD_CopyInput - SUBROUTINE WD_DestroyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE WD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInput' + LOGICAL,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 @@ -3556,15 +3678,27 @@ SUBROUTINE WD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE WD_CopyOutput - SUBROUTINE WD_DestroyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE WD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) TYPE(WD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyOutput' + LOGICAL,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 diff --git a/reg_tests/CMakeLists.txt b/reg_tests/CMakeLists.txt index 3587cd56d2..50c5857687 100644 --- a/reg_tests/CMakeLists.txt +++ b/reg_tests/CMakeLists.txt @@ -37,31 +37,33 @@ option(CTEST_PLOT_ERRORS "Generate plots of regression test errors." OFF) # Do not display outputs when running openfast, store in log file option(CTEST_RUN_VERBOSE_FLAG "Display run outputs or store to log file." OFF) +option(CTEST_NO_RUN_FLAG "Complete the regression test comparison but do not execute the simulation. Local results must already be generated." OFF) + # Set the OpenFAST executable configuration option and default -set(CTEST_OPENFAST_EXECUTABLE "${CMAKE_BINARY_DIR}/glue-codes/openfast/openfast" CACHE FILEPATH "Specify the OpenFAST executable to use in testing.") +set(CTEST_OPENFAST_EXECUTABLE "${CMAKE_BINARY_DIR}/glue-codes/openfast/openfast${CMAKE_EXECUTABLE_SUFFIX}" CACHE FILEPATH "Specify the OpenFAST executable to use in testing.") if(BUILD_OPENFAST_CPP_API) # Set the OpenFAST executable configuration option and default - set(CTEST_OPENFASTCPP_EXECUTABLE "${CMAKE_BINARY_DIR}/glue-codes/openfast-cpp/openfastcpp" CACHE FILEPATH "Specify the OpenFAST C++ executable to use in testing.") + set(CTEST_OPENFASTCPP_EXECUTABLE "${CMAKE_BINARY_DIR}/glue-codes/openfast-cpp/openfastcpp${CMAKE_EXECUTABLE_SUFFIX}" CACHE FILEPATH "Specify the OpenFAST C++ executable to use in testing.") endif() # Set the FASTFarm executable configuration option and default -set(CTEST_FASTFARM_EXECUTABLE "${CMAKE_BINARY_DIR}/glue-codes/fast-farm/FAST.Farm" CACHE FILEPATH "Specify the FASTFarm executable to use in testing.") +set(CTEST_FASTFARM_EXECUTABLE "${CMAKE_BINARY_DIR}/glue-codes/fast-farm/FAST.Farm${CMAKE_EXECUTABLE_SUFFIX}" CACHE FILEPATH "Specify the FASTFarm executable to use in testing.") # Set the AeroDyn executable configuration option and default set(CTEST_AERODYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/aerodyn/aerodyn_driver${CMAKE_EXECUTABLE_SUFFIX}" CACHE FILEPATH "Specify the AeroDyn driver executable to use in testing.") # Set the BeamDyn executable configuration option and default -set(CTEST_BEAMDYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/beamdyn/beamdyn_driver" CACHE FILEPATH "Specify the BeamDyn driver executable to use in testing.") +set(CTEST_BEAMDYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/beamdyn/beamdyn_driver${CMAKE_EXECUTABLE_SUFFIX}" CACHE FILEPATH "Specify the BeamDyn driver executable to use in testing.") # Set the HydroDyn executable configuration option and default -set(CTEST_HYDRODYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/hydrodyn/hydrodyn_driver" CACHE FILEPATH "Specify the HydroDyn driver executable to use in testing.") +set(CTEST_HYDRODYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/hydrodyn/hydrodyn_driver${CMAKE_EXECUTABLE_SUFFIX}" CACHE FILEPATH "Specify the HydroDyn driver executable to use in testing.") # Set the SubDyn executable configuration option and default -set(CTEST_SUBDYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/subdyn/subdyn_driver" CACHE FILEPATH "Specify the SubDyn driver executable to use in testing.") +set(CTEST_SUBDYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/subdyn/subdyn_driver${CMAKE_EXECUTABLE_SUFFIX}" CACHE FILEPATH "Specify the SubDyn driver executable to use in testing.") # Set the InflowWind executable configuration option and default -set(CTEST_INFLOWWIND_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/inflowwind/inflowwind_driver" CACHE FILEPATH "Specify the InflowWind driver executable to use in testing.") +set(CTEST_INFLOWWIND_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/inflowwind/inflowwind_driver${CMAKE_EXECUTABLE_SUFFIX}" CACHE FILEPATH "Specify the InflowWind driver executable to use in testing.") # Set the python executable configuration option and default if(NOT EXISTS ${PYTHON_EXECUTABLE}) @@ -72,12 +74,8 @@ if(NOT EXISTS ${PYTHON_EXECUTABLE}) endif() # Set the testing tolerance -set(CTEST_REGRESSION_TOL "0.00001" CACHE STRING "Set the tolerance for the regression test. Leave empty to automatically set.") -if(NOT ${CTEST_REGRESSION_TOL} STREQUAL "") - set(TOLERANCE ${CTEST_REGRESSION_TOL}) -else(NOT ${CTEST_REGRESSION_TOL} STREQUAL "") - set(TOLERANCE 0.00001) -endif() +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.") # include the r-test cmake projects (servodyn controllers) add_subdirectory("${CMAKE_CURRENT_LIST_DIR}/r-test") @@ -163,9 +161,8 @@ add_custom_command( ) add_custom_target( - regression_tests + regression_test_controllers DEPENDS - openfast "${of_dest}/DISCON.dll" "${of_dest}/DISCON_ITIBarge.dll" "${of_dest}/DISCON_OC3Hywind.dll" @@ -176,3 +173,20 @@ add_custom_target( "${ff_dest}/DISCON_WT2.dll" "${ff_dest}/DISCON_WT3.dll" ) + +add_custom_target( + regression_tests + DEPENDS + openfast + regression_test_controllers +) + +add_custom_target( + regression_test_module_drivers + DEPENDS + aerodyn_driver + beamdyn_driver + hydrodyn_driver + inflowwind_driver + subdyn_driver +) \ No newline at end of file diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 7542433367..f7051b3f8c 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -49,6 +49,11 @@ function(regression TEST_SCRIPT EXECUTABLE SOURCE_DIRECTORY BUILD_DIRECTORY TEST set(TESTDIR ${extra_args}) endif() + set(NO_RUN_FLAG "") + if(CTEST_NO_RUN_FLAG) + set(NO_RUN_FLAG "-n") + endif() + add_test( ${TESTNAME} ${PYTHON_EXECUTABLE} ${TEST_SCRIPT} @@ -56,11 +61,11 @@ function(regression TEST_SCRIPT EXECUTABLE SOURCE_DIRECTORY BUILD_DIRECTORY TEST ${EXECUTABLE} ${SOURCE_DIRECTORY} # openfast source directory ${BUILD_DIRECTORY} # build directory for test - ${TOLERANCE} - ${CMAKE_SYSTEM_NAME} # [Darwin,Linux,Windows] - ${CMAKE_Fortran_COMPILER_ID} # [Intel,GNU] + ${CTEST_RTEST_RTOL} + ${CTEST_RTEST_ATOL} ${PLOT_FLAG} # empty or "-p" ${RUN_VERBOSE_FLAG} # empty or "-v" + ${NO_RUN_FLAG} # empty or "-n" ) # limit each test to 90 minutes: 5400s set_tests_properties(${TESTNAME} PROPERTIES TIMEOUT 5400 WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" LABELS "${LABEL}") @@ -79,13 +84,13 @@ function(of_regression TESTNAME LABEL) regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") endfunction(of_regression) -function(of_cpp_regression TESTNAME LABEL) +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_cpp") 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}_cpp" "${LABEL}" ${TESTNAME}) -endfunction(of_cpp_regression) + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} "${TESTNAME}_fastlib" "${LABEL}" ${TESTNAME}) +endfunction(of_fastlib_regression) # openfast aeroacoustic function(of_regression_aeroacoustic TESTNAME LABEL) @@ -216,19 +221,19 @@ of_regression("AWT_WSt_StartUpShutDown" "openfast;elastodyn;aerodyn15;se 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_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("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_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") @@ -240,27 +245,22 @@ of_regression("StC_test_OC4Semi" "openfast;servodyn;hydrod # OpenFAST C++ API test if(BUILD_OPENFAST_CPP_API) - of_cpp_interface_regression("5MW_Land_DLL_WTurb_cpp" "openfast;openfastlib;cpp") + of_cpp_interface_regression("5MW_Land_DLL_WTurb_cpp" "openfast;fastlib;cpp") endif() -# # Python-based OpenFAST Library unit tests -# if(BUILD_SHARED_LIBS) -# py_openfast_library_regression("py_openfastlib" "python;openfastlib") -# endif() - -# OpenFAST C++ Driver test +# OpenFAST C++ Driver test for OpenFAST Library # This tests the FAST Library and FAST_Library.h -of_cpp_regression("AWT_YFree_WSt" "openfast;openfastlib;cpp;elastodyn;aerodyn15;servodyn") +of_fastlib_regression("AWT_YFree_WSt" "fastlib;elastodyn;aerodyn15;servodyn") # OpenFAST Python API test -of_regression_py("5MW_Land_DLL_WTurb_py" "openfast;openfastlib;python;elastodyn;aerodyn15;servodyn") -of_regression_py("5MW_ITIBarge_DLL_WTurb_WavesIrr_py" "openfast;openfastlib;python;elastodyn;aerodyn14;servodyn;hydrodyn;map;offshore") -of_regression_py("5MW_TLP_DLL_WTurb_WavesIrr_WavesMulti_py" "openfast;openfastlib;python;elastodyn;aerodyn15;servodyn;hydrodyn;map;offshore") -of_regression_py("5MW_OC3Spar_DLL_WTurb_WavesIrr_py" "openfast;openfastlib;python;elastodyn;aerodyn15;servodyn;hydrodyn;map;offshore") -of_regression_py("5MW_OC4Semi_WSt_WavesWN_py" "openfast;openfastlib;python;elastodyn;aerodyn15;servodyn;hydrodyn;moordyn;offshore") -of_regression_py("5MW_Land_BD_DLL_WTurb_py" "openfast;openfastlib;python;beamdyn;aerodyn15;servodyn") -of_regression_py("HelicalWake_OLAF_py" "openfast;openfastlib;python;aerodyn15;olaf") -of_regression_py("EllipticalWing_OLAF_py" "openfast;openfastlib;python;aerodyn15;olaf") +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") # AeroAcoustic regression test of_regression_aeroacoustic("IEA_LB_RWT-AeroAcoustics" "openfast;aerodyn15;aeroacoustics") @@ -291,6 +291,7 @@ ad_regression("ad_VerticalAxis_OLAF" "aerodyn;bem") ad_regression("ad_BAR_CombinedCases" "aerodyn;bem") # NOTE: doing BAR at the end to avoid copy errors 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") # BeamDyn regression tests @@ -304,8 +305,9 @@ 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") diff --git a/reg_tests/executeAerodynRegressionCase.py b/reg_tests/executeAerodynRegressionCase.py index 1462914737..98cae58380 100644 --- a/reg_tests/executeAerodynRegressionCase.py +++ b/reg_tests/executeAerodynRegressionCase.py @@ -27,6 +27,7 @@ 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 @@ -46,9 +47,8 @@ parser.add_argument("executable", metavar="AeroDyn-Driver", type=str, nargs=1, help="The path to the AeroDyn driver executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("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") @@ -59,9 +59,8 @@ executable = args.executable[0] sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] - - +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot noExec = args.noExec verbose = args.verbose @@ -110,46 +109,47 @@ caseInputFile = os.path.join(testBuildDirectory, "ad_driver.dvr") returnCode = openfastDrivers.runAerodynDriverCase(caseInputFile, executable, verbose=verbose) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) -###Build the filesystem navigation variables for running the regression test +### Build the filesystem navigation variables for running the regression test # For multiple turbines, test turbine 2, for combined cases, test case 4 localOutFile = os.path.join(testBuildDirectory, "ad_driver.outb") localOutFileWT2 = os.path.join(testBuildDirectory, "ad_driver.T2.outb") localOutFileCase4 = os.path.join(testBuildDirectory, "ad_driver.4.outb") if os.path.exists(localOutFileWT2) : - localOutFile=localOutFileWT2 + localOutFile = localOutFileWT2 elif os.path.exists(localOutFileCase4) : - localOutFile=localOutFileCase4 + localOutFile = localOutFileCase4 baselineOutFile = os.path.join(targetOutputDirectory, os.path.basename(localOutFile)) + rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] + +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 -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - # passing case -sys.exit(0) +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/executeBeamdynRegressionCase.py b/reg_tests/executeBeamdynRegressionCase.py index 93dbc01f74..aa40c473b6 100644 --- a/reg_tests/executeBeamdynRegressionCase.py +++ b/reg_tests/executeBeamdynRegressionCase.py @@ -27,6 +27,7 @@ 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 subprocess import rtestlib as rtl @@ -45,9 +46,8 @@ parser.add_argument("executable", metavar="BeamDyn-Driver", type=str, nargs=1, help="The path to the BeamDyn driver executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("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") @@ -58,7 +58,8 @@ executable = args.executable[0] sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot if args.plot is False else True noExec = args.noExec if args.noExec is False else True verbose = args.verbose if args.verbose is False else True @@ -99,7 +100,7 @@ caseInputFile = os.path.join(testBuildDirectory, "bd_driver.inp") returnCode = openfastDrivers.runBeamdynDriverCase(caseInputFile, executable) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, "bd_driver.out") @@ -107,31 +108,31 @@ rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] + +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 -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - # passing case -sys.exit(0) +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/executeFASTFarmRegressionCase.py b/reg_tests/executeFASTFarmRegressionCase.py index 273637bb46..65d0295535 100644 --- a/reg_tests/executeFASTFarmRegressionCase.py +++ b/reg_tests/executeFASTFarmRegressionCase.py @@ -27,6 +27,7 @@ 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 subprocess import rtestlib as rtl @@ -35,13 +36,7 @@ from errorPlotting import exportCaseSummary ##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) +excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] ##### Main program @@ -54,9 +49,8 @@ def ignoreBaselineItems(directory, contents): parser.add_argument("executable", metavar="OpenFAST", type=str, nargs=1, help="The path to the OpenFAST executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("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") @@ -67,9 +61,8 @@ def ignoreBaselineItems(directory, contents): executable = args.executable[0] sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[0] +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot noExec = args.noExec verbose = args.verbose @@ -80,25 +73,6 @@ def ignoreBaselineItems(directory, contents): if not os.path.isdir(buildDirectory): os.makedirs(buildDirectory) -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) ### Build the filesystem navigation variables for running openfast on the test case regtests = os.path.join(sourceDirectory, "reg_tests") @@ -106,7 +80,7 @@ def ignoreBaselineItems(directory, contents): rtest = os.path.join(regtests, "r-test") moduleDirectory = os.path.join(rtest, "glue-codes", "fast-farm") inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(inputsDirectory) #, outputType) +targetOutputDirectory = os.path.join(inputsDirectory) testBuildDirectory = os.path.join(buildDirectory, caseName) # verify all the required directories exist @@ -121,7 +95,7 @@ def ignoreBaselineItems(directory, contents): dst = os.path.join(buildDirectory, "5MW_Baseline") src = os.path.join(moduleDirectory, "5MW_Baseline") if not os.path.isdir(dst): - shutil.copytree(src, dst) + rtl.copyTree(src, dst, excludeExt=excludeExt) else: names = os.listdir(src) for name in names: @@ -131,19 +105,19 @@ def ignoreBaselineItems(directory, contents): dstname = os.path.join(dst, name) if os.path.isdir(srcname): if not os.path.isdir(dstname): - shutil.copytree(srcname, dstname) + rtl.copyTree(srcname, dstname, excludeExt=excludeExt) else: shutil.copy2(srcname, dstname) if not os.path.isdir(testBuildDirectory): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) ### Run openfast on the test case if not noExec: caseInputFile = os.path.join(testBuildDirectory, caseName + ".fstf") returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, caseName + ".out") @@ -151,29 +125,31 @@ def ignoreBaselineItems(directory, contents): rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) +passing_channels = passing_channels.T -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - for channel in testInfo["attribute_names"]: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error)) - finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) - - sys.exit(1) +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 -sys.exit(0) +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/executeHydrodynPyRegressionCase.py b/reg_tests/executeHydrodynPyRegressionCase.py index 6f8107cd4a..a7d95415f0 100644 --- a/reg_tests/executeHydrodynPyRegressionCase.py +++ b/reg_tests/executeHydrodynPyRegressionCase.py @@ -24,9 +24,10 @@ import os import sys -basepath = os.path.dirname(__file__) +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 @@ -46,9 +47,8 @@ parser.add_argument("executable", metavar="HydroDyn-Python", type=str, nargs=1, help="The path to the Python executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("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", default=False, metavar="Plotting-Flag", type=bool, nargs="?", help="bool to include matplotlib plots in failed cases") parser.add_argument("-n", "-no-exec", dest="noExec", default=False, metavar="No-Execution", type=bool, nargs="?", help="bool to prevent execution of the test cases") parser.add_argument("-v", "-verbose", dest="verbose", default=False, metavar="Verbose-Flag", type=bool, nargs="?", help="bool to include verbose system output") @@ -59,7 +59,8 @@ executable = args.executable[0] sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot if args.plot is False else True noExec = args.noExec if args.noExec is False else True verbose = args.verbose if args.verbose is False else True @@ -106,7 +107,7 @@ caseInputFile = os.path.join(testBuildDirectory, "hydrodyn_driver.py") returnCode = openfastDrivers.runHydrodynDriverCase(caseInputFile, executable) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, "hd_py.out") @@ -114,31 +115,31 @@ rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] + +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 -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - # passing case -sys.exit(0) +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/executeHydrodynRegressionCase.py b/reg_tests/executeHydrodynRegressionCase.py index 2c442eb6ba..ae67452dbc 100644 --- a/reg_tests/executeHydrodynRegressionCase.py +++ b/reg_tests/executeHydrodynRegressionCase.py @@ -27,6 +27,7 @@ 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 @@ -36,6 +37,7 @@ from errorPlotting import exportCaseSummary ##### Main program +excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] ### Store the python executable for future python calls pythonCommand = sys.executable @@ -46,12 +48,11 @@ parser.add_argument("executable", metavar="HydroDyn-Driver", type=str, nargs=1, help="The path to the HydroDyn driver executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -parser.add_argument("-p", "-plot", dest="plot", default=False, metavar="Plotting-Flag", type=bool, nargs="?", help="bool to include matplotlib plots in failed cases") -parser.add_argument("-n", "-no-exec", dest="noExec", default=False, metavar="No-Execution", type=bool, nargs="?", help="bool to prevent execution of the test cases") -parser.add_argument("-v", "-verbose", dest="verbose", default=False, metavar="Verbose-Flag", type=bool, nargs="?", help="bool to include verbose system output") +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", default=False, const=True, metavar="Plotting-Flag", type=bool, nargs="?", help="bool to include matplotlib plots in failed cases") +parser.add_argument("-n", "-no-exec", dest="noExec", default=False, const=True, metavar="No-Execution", type=bool, nargs="?", help="bool to prevent execution of the test cases") +parser.add_argument("-v", "-verbose", dest="verbose", default=False, const=True, metavar="Verbose-Flag", type=bool, nargs="?", help="bool to include verbose system output") args = parser.parse_args() @@ -59,7 +60,8 @@ executable = args.executable[0] sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot if args.plot is False else True noExec = args.noExec if args.noExec is False else True verbose = args.verbose if args.verbose is False else True @@ -97,13 +99,19 @@ 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)) + +dirToCopy = os.path.join("glue-codes","openfast","5MW_Baseline","HydroData") +buildDirectoryGlue = os.path.join(buildDirectory,os.pardir,os.pardir,dirToCopy) +if not os.path.isdir(buildDirectoryGlue): + src = os.path.join(rtest,dirToCopy) + rtl.copyTree(src, buildDirectoryGlue, excludeExt=excludeExt) ### Run HydroDyn on the test case if not noExec: caseInputFile = os.path.join(testBuildDirectory, "hd_driver.inp") returnCode = openfastDrivers.runHydrodynDriverCase(caseInputFile, executable) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, "driver.HD.out") @@ -111,31 +119,31 @@ rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] + +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 -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - # passing case -sys.exit(0) +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/executeInflowwindPyRegressionCase.py b/reg_tests/executeInflowwindPyRegressionCase.py index 7d88591ba9..3981c4f82e 100644 --- a/reg_tests/executeInflowwindPyRegressionCase.py +++ b/reg_tests/executeInflowwindPyRegressionCase.py @@ -27,6 +27,7 @@ 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 @@ -46,9 +47,8 @@ parser.add_argument("executable", metavar="InflowWind-Python", type=str, nargs=1, help="The path to the InflowWind driver executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("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") @@ -59,7 +59,8 @@ executable = args.executable[0] sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot if args.plot is False else True noExec = args.noExec if args.noExec is False else True verbose = args.verbose if args.verbose is False else True @@ -103,7 +104,7 @@ caseInputFile = os.path.join(testBuildDirectory, "inflowWind_testDriver.py") returnCode = openfastDrivers.runInflowwindDriverCase(caseInputFile, executable) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, "Points.Velocity.dat") @@ -111,31 +112,31 @@ rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] + +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 -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - # passing case -sys.exit(0) +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/executeInflowwindRegressionCase.py b/reg_tests/executeInflowwindRegressionCase.py index 42c99d6289..d06b802e12 100644 --- a/reg_tests/executeInflowwindRegressionCase.py +++ b/reg_tests/executeInflowwindRegressionCase.py @@ -27,6 +27,7 @@ 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 @@ -46,9 +47,8 @@ parser.add_argument("executable", metavar="InflowWind-Driver", type=str, nargs=1, help="The path to the InflowWind driver executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("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") @@ -59,7 +59,8 @@ executable = args.executable[0] sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot if args.plot is False else True noExec = args.noExec if args.noExec is False else True verbose = args.verbose if args.verbose is False else True @@ -100,7 +101,7 @@ caseInputFile = os.path.join(testBuildDirectory, "ifw_driver.inp") returnCode = openfastDrivers.runInflowwindDriverCase(caseInputFile, executable) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, "Points.Velocity.dat") @@ -108,31 +109,31 @@ rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] + +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 -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - # passing case -sys.exit(0) +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/executeOpenfastAeroAcousticRegressionCase.py b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py index 381879eb25..002f21a056 100644 --- a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py +++ b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py @@ -28,6 +28,7 @@ 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 subprocess import rtestlib as rtl @@ -36,13 +37,7 @@ from errorPlotting import exportCaseSummary ##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) +excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] ##### Main program @@ -55,9 +50,8 @@ def ignoreBaselineItems(directory, contents): parser.add_argument("executable", metavar="OpenFAST", type=str, nargs=1, help="The path to the OpenFAST executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("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") @@ -68,9 +62,8 @@ def ignoreBaselineItems(directory, contents): executable = args.executable[0] sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[0] +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot noExec = args.noExec verbose = args.verbose @@ -81,37 +74,17 @@ def ignoreBaselineItems(directory, contents): if not os.path.isdir(buildDirectory): os.makedirs(buildDirectory) -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) - ### Build the filesystem navigation variables for running openfast on the test case regtests = os.path.join(sourceDirectory, "reg_tests") lib = os.path.join(regtests, "lib") rtest = os.path.join(regtests, "r-test") moduleDirectory = os.path.join(rtest, "glue-codes", "openfast") inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(inputsDirectory, outputType) +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)) @@ -123,14 +96,14 @@ def ignoreBaselineItems(directory, contents): # create the local output directory if it does not already exist # and initialize it with input files for all test cases if not os.path.isdir(testBuildDirectory): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) - + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) + ### Run openfast on the test case if not noExec: caseInputFile = os.path.join(testBuildDirectory, caseName + ".fst") returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test # testing on file 2. Gives each observer and sweep of frequency ranges @@ -139,31 +112,31 @@ def ignoreBaselineItems(directory, contents): rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] + +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 -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - # passing case -sys.exit(0) +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/executeOpenfastCppRegressionCase.py b/reg_tests/executeOpenfastCppRegressionCase.py index 03f9cccc2b..82a7c248db 100644 --- a/reg_tests/executeOpenfastCppRegressionCase.py +++ b/reg_tests/executeOpenfastCppRegressionCase.py @@ -19,6 +19,7 @@ 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 subprocess import rtestlib as rtl @@ -27,13 +28,7 @@ from errorPlotting import exportCaseSummary ##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) +excludeExt=['.out','.outb','.ech','.sum','.log'] ##### Main program @@ -46,9 +41,8 @@ def ignoreBaselineItems(directory, contents): parser.add_argument("executable", metavar="OpenFAST", type=str, nargs=1, help="The path to the OpenFAST executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("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") @@ -59,9 +53,8 @@ def ignoreBaselineItems(directory, contents): executable = os.path.abspath(args.executable[0]) sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[0] +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot noExec = args.noExec verbose = args.verbose @@ -72,32 +65,13 @@ def ignoreBaselineItems(directory, contents): if not os.path.isdir(buildDirectory): os.makedirs(buildDirectory) -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) ### Build the filesystem navigation variables for running openfast on the test case rtest = os.path.join(sourceDirectory, "reg_tests", "r-test") moduleDirectory = os.path.join(rtest, "glue-codes", "openfast-cpp") openfast_gluecode_directory = os.path.join(rtest, "glue-codes", "openfast") inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(openfast_gluecode_directory, caseName.replace('_cpp', ''), outputType) +targetOutputDirectory = os.path.join(openfast_gluecode_directory, caseName.replace('_cpp', '')) testBuildDirectory = os.path.join(buildDirectory, caseName) # verify all the required directories exist @@ -112,7 +86,7 @@ def ignoreBaselineItems(directory, contents): dst = os.path.join(buildDirectory, "5MW_Baseline") src = os.path.join(openfast_gluecode_directory, "5MW_Baseline") if not os.path.isdir(dst): - shutil.copytree(src, dst) + rtl.copyTree(src, dst, excludeExt=excludeExt) else: names = os.listdir(src) for name in names: @@ -122,12 +96,12 @@ def ignoreBaselineItems(directory, contents): dstname = os.path.join(dst, name) if os.path.isdir(srcname): if not os.path.isdir(dstname): - shutil.copytree(srcname, dstname) + rtl.copyTree(srcname, dstname, excludeExt=excludeExt) else: shutil.copy2(srcname, dstname) if not os.path.isdir(testBuildDirectory): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) ### Run openfast on the test case if not noExec: @@ -136,38 +110,41 @@ def ignoreBaselineItems(directory, contents): caseInputFile = os.path.abspath("cDriver.yaml") returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) os.chdir(cwd) ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") baselineOutFile = os.path.join(targetOutputDirectory, caseName.replace('_cpp', '') + ".outb") + rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) +passing_channels = passing_channels.T -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - for channel in testInfo["attribute_names"]: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error)) - finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) - - sys.exit(1) +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 -sys.exit(0) +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/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 8e8a9b7015..4eed9f259e 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -27,6 +27,7 @@ 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 subprocess import rtestlib as rtl @@ -35,13 +36,7 @@ from errorPlotting import exportCaseSummary ##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) +excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] def file_line_count(filename): file_handle = open(filename, 'r') @@ -64,12 +59,11 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): parser.add_argument("executable", metavar="OpenFAST", type=str, nargs=1, help="The path to the OpenFAST executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -parser.add_argument("-p", "-plot", dest="plot", default=False, metavar="Plotting-Flag", type=bool, nargs="?", help="bool to include plots in failed cases") -parser.add_argument("-n", "-no-exec", dest="noExec", default=False, metavar="No-Execution", type=bool, nargs="?", help="bool to prevent execution of the test cases") -parser.add_argument("-v", "-verbose", dest="verbose", default=False, metavar="Verbose-Flag", type=bool, nargs="?", help="bool to include verbose system output") +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() @@ -77,12 +71,17 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): executable = args.executable[0] sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[0] -plotError = args.plot if args.plot is False else True -noExec = args.noExec if args.noExec is False else True -verbose = args.verbose if args.verbose is False else True +rtol = args.rtol[0] +atol = args.atol[0] +plotError = args.plot +noExec = args.noExec +verbose = args.verbose + +# Tolerance have not been tuned for linearization case outputs. +# This is using 1e-5 since that seemed like a decent value prior to +# switching to relative and absolute tolerance. +rtol = 1e-5 +atol = 1e-5 # validate inputs rtl.validateExeOrExit(executable) @@ -90,33 +89,13 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): if not os.path.isdir(buildDirectory): os.makedirs(buildDirectory) -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) - ### Build the filesystem navigation variables for running openfast on the test case regtests = os.path.join(sourceDirectory, "reg_tests") lib = os.path.join(regtests, "lib") rtest = os.path.join(regtests, "r-test") moduleDirectory = os.path.join(rtest, "glue-codes", "openfast") inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(inputsDirectory, outputType) +targetOutputDirectory = os.path.join(inputsDirectory) testBuildDirectory = os.path.join(buildDirectory, caseName) # verify all the required directories exist @@ -132,13 +111,13 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): for data in ["Ideal_Beam", "WP_Baseline"]: dataDir = os.path.join(buildDirectory, data) if not os.path.isdir(dataDir): - shutil.copytree(os.path.join(moduleDirectory, data), dataDir) + rtl.copyTree(os.path.join(moduleDirectory, data), dataDir, excludeExt=excludeExt) # Special copy for the 5MW_Baseline folder because the Windows python-only workflow may have already created data in the subfolder ServoData dst = os.path.join(buildDirectory, "5MW_Baseline") src = os.path.join(moduleDirectory, "5MW_Baseline") if not os.path.isdir(dst): - shutil.copytree(src, dst) + rtl.copyTree(src, dst, excludeExt=excludeExt) else: names = os.listdir(src) for name in names: @@ -148,25 +127,22 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): dstname = os.path.join(dst, name) if os.path.isdir(srcname): if not os.path.isdir(dstname): - shutil.copytree(srcname, dstname) + rtl.copyTree(srcname, dstname, excludeExt=excludeExt) else: shutil.copy2(srcname, dstname) if not os.path.isdir(testBuildDirectory): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) ### Run openfast on the test case if not noExec: caseInputFile = os.path.join(testBuildDirectory, caseName + ".fst") returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) -### Get a list of all the files in the baseline directory -baselineOutFiles = os.listdir(targetOutputDirectory) -# Drop the log file, if its listed -if caseName + '.log' in baselineOutFiles: - baselineOutFiles.remove(caseName + '.log') +### Get a all the .lin files in the baseline directory +baselineOutFiles = [f for f in os.listdir(targetOutputDirectory) if '.lin' in f] # these should all exist in the local outputs directory localFiles = os.listdir(testBuildDirectory) @@ -239,8 +215,10 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): for j, l_element in enumerate(l_elements): l_float = float(l_element) b_float = float(b_elements[j]) - if not isclose(l_float, b_float, tolerance, tolerance): - print(f"Failed in Jacobian matrix comparison: {l_float} and {b_float}") + if not isclose(l_float, b_float, rtol, atol): + print(f"Failed in Jacobian matrix comparison:") + print(f"{l_float} in {local_file}") + print(f"{b_float} in {baseline_file}") sys.exit(1) # skip 2 empty/header lines @@ -261,7 +239,7 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): for j, l_element in enumerate(l_elements): l_float = float(l_element) b_float = float(b_elements[j]) - if not isclose(l_float, b_float, tolerance, tolerance): + if not isclose(l_float, b_float, rtol, atol): print(f"Failed in state matrix comparison: {l_float} and {b_float}") sys.exit(1) diff --git a/reg_tests/executeOpenfastRegressionCase.py b/reg_tests/executeOpenfastRegressionCase.py index 2bb1bb14ca..a0cae63e6b 100644 --- a/reg_tests/executeOpenfastRegressionCase.py +++ b/reg_tests/executeOpenfastRegressionCase.py @@ -27,6 +27,7 @@ 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 subprocess import rtestlib as rtl @@ -35,13 +36,7 @@ from errorPlotting import exportCaseSummary ##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) +excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] ##### Main program @@ -54,9 +49,8 @@ def ignoreBaselineItems(directory, contents): parser.add_argument("executable", metavar="OpenFAST", type=str, nargs=1, help="The path to the OpenFAST executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("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") @@ -67,9 +61,8 @@ def ignoreBaselineItems(directory, contents): executable = args.executable[0] sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[0] +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot noExec = args.noExec verbose = args.verbose @@ -80,25 +73,6 @@ def ignoreBaselineItems(directory, contents): if not os.path.isdir(buildDirectory): os.makedirs(buildDirectory) -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) ### Build the filesystem navigation variables for running openfast on the test case regtests = os.path.join(sourceDirectory, "reg_tests") @@ -106,7 +80,7 @@ def ignoreBaselineItems(directory, contents): rtest = os.path.join(regtests, "r-test") moduleDirectory = os.path.join(rtest, "glue-codes", "openfast") inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(inputsDirectory, outputType) +targetOutputDirectory = os.path.join(inputsDirectory) testBuildDirectory = os.path.join(buildDirectory, caseName) # verify all the required directories exist @@ -122,13 +96,13 @@ def ignoreBaselineItems(directory, contents): for data in ["AOC", "AWT27", "SWRT", "UAE_VI", "WP_Baseline"]: dataDir = os.path.join(buildDirectory, data) if not os.path.isdir(dataDir): - shutil.copytree(os.path.join(moduleDirectory, data), dataDir) + rtl.copyTree(os.path.join(moduleDirectory, data), dataDir, excludeExt=excludeExt) # Special copy for the 5MW_Baseline folder because the Windows python-only workflow may have already created data in the subfolder ServoData dst = os.path.join(buildDirectory, "5MW_Baseline") src = os.path.join(moduleDirectory, "5MW_Baseline") if not os.path.isdir(dst): - shutil.copytree(src, dst) + rtl.copyTree(src, dst, excludeExt=excludeExt) else: names = os.listdir(src) for name in names: @@ -138,19 +112,19 @@ def ignoreBaselineItems(directory, contents): dstname = os.path.join(dst, name) if os.path.isdir(srcname): if not os.path.isdir(dstname): - shutil.copytree(srcname, dstname) + rtl.copyTree(srcname, dstname, excludeExt=excludeExt) else: shutil.copy2(srcname, dstname) if not os.path.isdir(testBuildDirectory): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) ### Run openfast on the test case if not noExec: caseInputFile = os.path.join(testBuildDirectory, caseName + ".fst") returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") @@ -158,29 +132,31 @@ def ignoreBaselineItems(directory, contents): rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) +passing_channels = passing_channels.T -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - for channel in testInfo["attribute_names"]: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error)) - finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) - - sys.exit(1) +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 -sys.exit(0) +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/executePythonRegressionCase.py b/reg_tests/executePythonRegressionCase.py index 58c2599290..9106c588b2 100644 --- a/reg_tests/executePythonRegressionCase.py +++ b/reg_tests/executePythonRegressionCase.py @@ -25,11 +25,12 @@ import os import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." +basepath = os.path.dirname(os.path.abspath(__file__)) sys.path.insert(0, os.path.sep.join([basepath, "lib"])) sys.path.insert(0, os.path.sep.join([basepath, "..", "glue-codes", "python"])) import platform import argparse +import numpy as np import shutil import subprocess import rtestlib as rtl @@ -39,13 +40,7 @@ import openfast_library ##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) +excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] ##### Main program @@ -58,9 +53,8 @@ def ignoreBaselineItems(directory, contents): parser.add_argument("executable", metavar="NotUsed", type=str, nargs=1, help="Not used in this script, but kept for API compatibility.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("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") @@ -70,9 +64,8 @@ def ignoreBaselineItems(directory, contents): caseName = args.caseName[0].replace("_py", "") sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[0] +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot noExec = args.noExec verbose = args.verbose @@ -82,25 +75,6 @@ def ignoreBaselineItems(directory, contents): if not os.path.isdir(buildDirectory): os.makedirs(buildDirectory) -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) ### Build the filesystem navigation variables for running openfast on the test case regtests = os.path.join(sourceDirectory, "reg_tests") @@ -108,7 +82,7 @@ def ignoreBaselineItems(directory, contents): rtest = os.path.join(regtests, "r-test") moduleDirectory = os.path.join(rtest, "glue-codes", "openfast") inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(inputsDirectory, outputType) +targetOutputDirectory = os.path.join(inputsDirectory) testBuildDirectory = os.path.join(buildDirectory, caseName) # verify all the required directories exist @@ -124,12 +98,13 @@ def ignoreBaselineItems(directory, contents): for data in ["AOC", "AWT27", "SWRT", "UAE_VI", "WP_Baseline"]: dataDir = os.path.join(buildDirectory, data) if not os.path.isdir(dataDir): - shutil.copytree(os.path.join(moduleDirectory, data), dataDir) + rtl.copyTree(os.path.join(moduleDirectory, data), dataDir, excludeExt=excludeExt) +# Special copy for the 5MW_Baseline folder because the Windows python-only workflow may have already created data in the subfolder ServoData dst = os.path.join(buildDirectory, "5MW_Baseline") src = os.path.join(moduleDirectory, "5MW_Baseline") if not os.path.isdir(dst): - shutil.copytree(src, dst) + rtl.copyTree(src, dst, excludeExt=excludeExt) else: names = os.listdir(src) for name in names: @@ -139,12 +114,12 @@ def ignoreBaselineItems(directory, contents): dstname = os.path.join(dst, name) if os.path.isdir(srcname): if not os.path.isdir(dstname): - shutil.copytree(srcname, dstname) + rtl.copyTree(srcname, dstname, excludeExt=excludeExt) else: shutil.copy2(srcname, dstname) if not os.path.isdir(testBuildDirectory): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) ### Run openfast on the test case if not noExec: @@ -165,6 +140,7 @@ def ignoreBaselineItems(directory, contents): output_channel_names = openfastlib.output_channel_names ### Build the filesystem navigation variables for running the regression test +localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") rtl.validateFileOrExit(baselineOutFile) @@ -173,27 +149,29 @@ def ignoreBaselineItems(directory, contents): } testData = openfastlib.output_values baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) +passing_channels = passing_channels.T -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - for channel in testInfo["attribute_names"]: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error)) - finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) - - sys.exit(1) +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 -sys.exit(0) +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 94e04a710f..9a71b167e5 100644 --- a/reg_tests/executeSubdynRegressionCase.py +++ b/reg_tests/executeSubdynRegressionCase.py @@ -27,6 +27,7 @@ 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 @@ -46,9 +47,8 @@ parser.add_argument("executable", metavar="SubDyn-Driver", type=str, nargs=1, help="The path to the SubDyn driver executable.") parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("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', default=False, help="bool to include matplotlib plots in failed cases") parser.add_argument("-n", "-no-exec", dest="noExec", action='store_true', default=False, help="bool to prevent execution of the test cases") parser.add_argument("-v", "-verbose", dest="verbose", action='store_true', default=False, help="bool to include verbose system output") @@ -59,7 +59,8 @@ executable = args.executable[0] sourceDirectory = args.sourceDirectory[0] buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] +rtol = args.rtol[0] +atol = args.atol[0] plotError = args.plot noExec = args.noExec verbose = args.verbose @@ -99,39 +100,40 @@ # run driver returnCode = openfastDrivers.runSubdynDriverCase(caseInputFile, executable, verbose=verbose) if returnCode != 0: - rtl.exitWithError("") + sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, caseName+".SD.out") baselineOutFile = os.path.join(targetOutputDirectory, caseName+".SD.out") + rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] + +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 -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - # passing case -sys.exit(0) +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/lib/errorPlotting.py b/reg_tests/lib/errorPlotting.py index 1778f3fe75..edebeeb70e 100644 --- a/reg_tests/lib/errorPlotting.py +++ b/reg_tests/lib/errorPlotting.py @@ -25,7 +25,6 @@ import os import sys import shutil - import numpy as np import rtestlib as rtl @@ -47,28 +46,43 @@ def _parseSolution(solution): except Exception as e: rtl.exitWithError("Error: {}".format(e)) -def _plotError(xseries, y1series, y2series, xlabel, title1, title2): +def _plotError(time, test, baseline, xlabel, title1, title2, RTOL_MAGNITUDE, ATOL_MAGNITUDE): from bokeh.embed import components from bokeh.layouts import gridplot from bokeh.plotting import figure - from bokeh.models.tools import HoverTool, BoxZoomTool + from bokeh.models.tools import HoverTool + # Plot the baseline and test channels p1 = figure(title=title1) p1.title.align = 'center' p1.grid.grid_line_alpha=0.3 p1.xaxis.axis_label = 'Time (s)' - p1.line(xseries, y2series, color='green', line_width=3, legend_label='Baseline') - p1.line(xseries, y1series, color='red', line_width=1, legend_label='Local') + p1.line(time, baseline, color='green', line_width=3, legend_label='Baseline') + p1.line(time, test, color='red', line_width=1, legend_label='Local') p1.add_tools(HoverTool(tooltips=[('Time','@x'), ('Value', '@y')],mode='vline')) + # Plot the error and threshold p2 = figure(title=title2, x_range=p1.x_range) p2.title.align = 'center' p2.grid.grid_line_alpha = 0 p2.xaxis.axis_label = 'Time (s)' - p2.line(xseries, abs(y2series - y1series), color='blue') + p2.line(time, abs(baseline - test), color='blue', legend_label="Error") + + # Calculate the threshold + NUMEPS = 1e-12 + ATOL_MIN = 1e-6 + baseline_offset = baseline - np.min(baseline) + b_order_of_magnitude = np.floor( np.log10( baseline_offset + NUMEPS ) ) + rtol = 10**(-1 * RTOL_MAGNITUDE) + atol = 10**(max(b_order_of_magnitude) - ATOL_MAGNITUDE) + atol = max(atol, ATOL_MIN) + passfail_line = atol + rtol * abs(baseline) + p2.line(time, passfail_line, color='red', legend_label="Threshold") + # p2.cross(xseries, passfail_line) + p2.add_tools(HoverTool(tooltips=[('Time','@x'), ('Error', '@y')], mode='vline')) - grid = gridplot([[p1, p2]], plot_width=650, plot_height=375, sizing_mode="scale_both") + grid = gridplot([[p1, p2]], width=650, height=375, sizing_mode="scale_both") script, div = components(grid) return script, div @@ -80,7 +94,7 @@ def _replace_id_div(html_string, plot): return html_string def _replace_id_script(html_string, plot): - id_start = html_string.find('var render_items') + id_start = html_string.find('const render_items') id_start += html_string[id_start:].find('roots') id_start += html_string[id_start:].find('":"') + 3 id_end = html_string[id_start:].find('"') + id_start @@ -92,7 +106,8 @@ def _save_plot(script, div, path, attribute): file_name = "_script".join((attribute, ".txt")) with open(os.path.join(path, file_name), 'w') as f: - script = _replace_id_script(script.replace('\n', '\n '), attribute) + script = script.replace('\n', '\n ') + script = _replace_id_script(script, attribute) f.write(script) file_name = "_div".join((attribute, ".txt")) @@ -104,7 +119,7 @@ def _save_plot(script, div, path, attribute): div = div.replace("' + '\n' + head += f' ' + '\n' head += ' ' + '\n' head += '